X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=NetWare%2Fnwperlsys.c;h=9eca5225f7fac1f4bf5ad21b6dfb6c69a0bcd326;hb=06252d99d92fd499350929655154d6e0527039a0;hp=b4406299fb92b6d81c95a1926fd68ee91763bd14;hpb=2986a63f7e513cf37f46db9f211b77071260031f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/NetWare/nwperlsys.c b/NetWare/nwperlsys.c index b440629..9eca522 100644 --- a/NetWare/nwperlsys.c +++ b/NetWare/nwperlsys.c @@ -7,1196 +7,27 @@ */ /* - * FILENAME : nwperlsys.c - * DESCRIPTION : Contains the platform specific functions calls + * FILENAME : nwperlsys.c + * DESCRIPTION : Contains calls to Perl APIs and + * utility functions calls * - * Author : SGP - * Date Created : June 12th 2001. - * Date Modified: + * Author : SGP + * Date Created : June 12th 2001. + * Date Modified: June 26th 2001. */ #include "EXTERN.h" #include "perl.h" -#ifdef PERL_OBJECT -#define NO_XSLOCKS -#endif - -//CHKSGP -//Including this is giving premature end-of-file error during compilation -//#include "XSUB.h" - -#ifdef PERL_IMPLICIT_SYS - -#include "nw5iop.h" -#include - - -#include "win32ish.h" - -START_EXTERN_C -extern int do_spawn2(char *cmd, int exectype); -extern int do_aspawn(void *vreally, void **vmark, void **vsp); -extern void Perl_init_os_extras(void); -extern BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList); -extern BOOL fnGetHashListAddrs(void *addrs, BOOL *dontTouchHashList); -END_EXTERN_C - -//Includes iperlsys.h and function definitions -#include "nwperlsys.h" - -/* IPerlStdio - Stdio functions - Begin ================================================*/ - -FILE* -PerlStdIOStdin(struct IPerlStdIO* piPerl) -{ - return nw_stdin(); -} - -FILE* -PerlStdIOStdout(struct IPerlStdIO* piPerl) -{ - return nw_stdout(); -} - -FILE* -PerlStdIOStderr(struct IPerlStdIO* piPerl) -{ - return nw_stderr(); -} - -FILE* -PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode) -{ - return nw_fopen(path, mode); -} - -int -PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_fclose(pf); -} - -int -PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_feof(pf); -} - -int -PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_ferror(pf); -} - -void -PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf) -{ - nw_clearerr(pf); -} - -int -PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_getc(pf); -} - -char* -PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf) -{ -#ifdef FILE_base - FILE *f = pf; - return FILE_base(f); -#else - return Nullch; -#endif -} - -int -PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf) -{ -#ifdef FILE_bufsiz - FILE *f = pf; - return FILE_bufsiz(f); -#else - return (-1); -#endif -} - -int -PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf) -{ -#ifdef USE_STDIO_PTR - FILE *f = pf; - return FILE_cnt(f); -#else - return (-1); -#endif -} - -char* -PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf) -{ -#ifdef USE_STDIO_PTR - FILE *f = pf; - return FILE_ptr(f); -#else - return Nullch; -#endif -} - -char* -PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n) -{ - return nw_fgets(s, n, pf); -} - -int -PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c) -{ - return nw_fputc(c, pf); -} - -int -PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s) -{ - return nw_fputs(s, pf); -} - -int -PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_fflush(pf); -} - -int -PerlStdIOUngetc(struct IPerlStdIO* piPerl, int c, FILE* pf) -{ - return nw_ungetc(c, pf); -} - -int -PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_fileno(pf); -} - -FILE* -PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode) -{ - return nw_fdopen(fd, mode); -} - -FILE* -PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf) -{ - return nw_freopen(path, mode, pf); -} - -SSize_t -PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf) -{ - return nw_fread(buffer, size, count, pf); -} - -SSize_t -PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf) -{ - return nw_fwrite(buffer, size, count, pf); -} - -void -PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer) -{ - nw_setbuf(pf, buffer); -} - -int -PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size) -{ - return nw_setvbuf(pf, buffer, type, size); -} - -void -PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n) -{ -#ifdef STDIO_CNT_LVALUE - FILE *f = pf; - FILE_cnt(f) = n; -#endif -} - -void -PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr) -{ -#ifdef STDIO_PTR_LVALUE - FILE *f = pf; - FILE_ptr(f) = ptr; -#endif -} - -void -PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf) -{ - nw_setvbuf(pf, NULL, _IOLBF, 0); -} - -int -PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...) -{ - va_list(arglist); - va_start(arglist, format); - return nw_vfprintf(pf, format, arglist); -} - -int -PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist) -{ - return nw_vfprintf(pf, format, arglist); -} - -long -PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf) -{ - return nw_ftell(pf); -} - -int -PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin) -{ - return nw_fseek(pf, offset, origin); -} - -void -PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf) -{ - nw_rewind(pf); -} - -FILE* -PerlStdIOTmpfile(struct IPerlStdIO* piPerl) -{ - return nw_tmpfile(); -} - -int -PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p) -{ - return nw_fgetpos(pf, p); -} - -int -PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p) -{ - return nw_fsetpos(pf, p); -} - -void -PerlStdIOInit(struct IPerlStdIO* piPerl) -{ -} - -void -PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl) -{ - Perl_init_os_extras(); -} - - -int -PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags) -{ - return nw_open_osfhandle(osfhandle, flags); -} - -int -PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum) -{ - return nw_get_osfhandle(filenum); -} - -FILE* -PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) -{ - FILE* pfdup=NULL; - fpos_t pos=0; - char mode[3]={'\0'}; - int fileno = nw_dup(nw_fileno(pf)); - - /* open the file in the same mode */ - if(((FILE*)pf)->_flag & _IOREAD) { - mode[0] = 'r'; - mode[1] = 0; - } - else if(((FILE*)pf)->_flag & _IOWRT) { - mode[0] = 'a'; - mode[1] = 0; - } - else if(((FILE*)pf)->_flag & _IORW) { - mode[0] = 'r'; - mode[1] = '+'; - mode[2] = 0; - } - - /* it appears that the binmode is attached to the - * file descriptor so binmode files will be handled - * correctly - */ - pfdup = nw_fdopen(fileno, mode); - - /* move the file pointer to the same position */ - if (!fgetpos(pf, &pos)) { - fsetpos(pfdup, &pos); - } - return pfdup; -} - -/* IPerlStdio - Stdio functions - End ================================================*/ - -/* IPerlDir - Directory Manipulation functions - Begin ===================================*/ - -int -PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode) -{ - return mkdir(dirname); -} - -int -PerlDirChdir(struct IPerlDir* piPerl, const char *dirname) -{ - return nw_chdir(dirname); -} - -int -PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname) -{ - return nw_rmdir(dirname); -} - -int -PerlDirClose(struct IPerlDir* piPerl, DIR *dirp) -{ - return nw_closedir(dirp); -} - -DIR* -PerlDirOpen(struct IPerlDir* piPerl, char *filename) -{ - return nw_opendir(filename); -} - -struct direct * -PerlDirRead(struct IPerlDir* piPerl, DIR *dirp) -{ - return nw_readdir(dirp); -} - -void -PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp) -{ - nw_rewinddir(dirp); -} - -void -PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc) -{ - nw_seekdir(dirp, loc); -} - -long -PerlDirTell(struct IPerlDir* piPerl, DIR *dirp) -{ - return nw_telldir(dirp); -} - -/* IPerlDir - Directory Manipulation functions - End ===================================*/ - -/* IPerlEnv - Environment related functions - Begin ======================================*/ - -char* -PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname) -{ - return(getenv(varname)); -}; - -int -PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring) -{ - return(putenv(envstring)); -}; - -char* -PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len) -{ - *len = 0; - char *e = getenv(varname); - if (e) - *len = strlen(e); - return e; -} - -int -PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name) -{ - return nw_uname(name); -} - -void -PerlEnvClearenv(struct IPerlEnv* piPerl) -{ - -} - -/* IPerlEnv - Environment related functions - End ======================================*/ - -/* IPerlLIO - Low-level IO functions - Begin =============================================*/ - -int -PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode) -{ - return nw_access(path, mode); -} - -int -PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode) -{ - return nw_chmod(filename, pmode); -} - -int -PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group) -{ - dTHXo; - Perl_croak(aTHX_ "chown not implemented!\n"); - return 0; -} - -int -PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size) -{ - return (nw_chsize(handle,size)); -} - -int -PerlLIOClose(struct IPerlLIO* piPerl, int handle) -{ - return nw_close(handle); -} - -int -PerlLIODup(struct IPerlLIO* piPerl, int handle) -{ - return nw_dup(handle); -} - -int -PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2) -{ - return nw_dup2(handle1, handle2); -} - -int -PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper) -{ - //On NetWare simulate flock by locking a range on the file - return nw_flock(fd, oper); -} - -int -PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) -{ - return fstat(handle, buffer); -} - -int -PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) -{ - return 0; -} - -int -PerlLIOIsatty(struct IPerlLIO* piPerl, int fd) -{ - return nw_isatty(fd); -} - -int -PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) -{ - return nw_link(oldname, newname); -} - -long -PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin) -{ - return nw_lseek(handle, offset, origin); -} - -int -PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) -{ - return nw_stat(path, buffer); -} - -char* -PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template) -{ - return(nw_mktemp(Template)); -} - -int -PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag) -{ - return nw_open(filename, oflag); -} - -int -PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode) -{ - return nw_open(filename, oflag, pmode); -} - -int -PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count) -{ - return nw_read(handle, buffer, count); -} - -int -PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname) -{ - return nw_rename(OldFileName, newname); -} - -int -PerlLIOSetmode(struct IPerlLIO* piPerl, FILE *fp, int mode) -{ - return nw_setmode(fp, mode); -} - -int -PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) -{ - return nw_stat(path, buffer); -} - -char* -PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string) -{ - return tmpnam(string); -} - -int -PerlLIOUmask(struct IPerlLIO* piPerl, int pmode) -{ - return umask(pmode); -} - -int -PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename) -{ - return nw_unlink(filename); -} - -int -PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times) -{ - return nw_utime(filename, times); -} - -int -PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count) -{ - return nw_write(handle, buffer, count); -} - -/* IPerlLIO - Low-level IO functions - End =============================================*/ - -/* IPerlMem - Memory management functions - Begin ========================================*/ - -void* -PerlMemMalloc(struct IPerlMem* piPerl, size_t size) -{ - void *ptr = NULL; - ptr = malloc(size); - if (ptr) { - void **listptr; - BOOL m_dontTouchHashLists; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - if (listptr) { - WCValHashTable* m_allocList= (WCValHashTable*)listptr; - (WCValHashTable*)m_allocList->insert(ptr); - } - } - } - return(ptr); -} - -void* -PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size) -{ - void *newptr = NULL; - WCValHashTable* m_allocList; - - newptr = realloc(ptr, size); - - if (ptr) - { - void **listptr; - BOOL m_dontTouchHashLists; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - m_allocList= (WCValHashTable*)listptr; - (WCValHashTable*)m_allocList->remove(ptr); - } - } - if (newptr) - { - if (m_allocList) - (WCValHashTable*)m_allocList->insert(newptr); - } - - return(newptr); -} - -void -PerlMemFree(struct IPerlMem* piPerl, void* ptr) -{ - BOOL m_dontTouchHashLists; - WCValHashTable* m_allocList; - - void **listptr; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - m_allocList= (WCValHashTable*)listptr; - // Final clean up, free all the nodes from the hash list - if (m_dontTouchHashLists) - { - if(ptr) - { - free(ptr); - ptr = NULL; - } - } - else - { - if(ptr && m_allocList) - { - if ((WCValHashTable*)m_allocList->remove(ptr)) - { - free(ptr); - ptr = NULL; - } - else - { - // If it comes here, that means that the memory pointer is not contained in the hash list. - // But no need to free now, since if is deleted here, it will result in an abend!! - // If the memory is still there, it will be cleaned during final cleanup anyway. - } - } - } - } - return; -} - -void* -PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size) -{ - void *ptr = NULL; - - ptr = calloc(num, size); - if (ptr) { - void **listptr; - BOOL m_dontTouchHashLists; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - if (listptr) { - WCValHashTable* m_allocList= (WCValHashTable*)listptr; - (WCValHashTable*)m_allocList->insert(ptr); - } - } - } - return(ptr); -} - -/* IPerlMem - Memory management functions - End ========================================*/ - -/* IPerlProc - Process control functions - Begin =========================================*/ - -#define EXECF_EXEC 1 -#define EXECF_SPAWN 2 - -void -PerlProcAbort(struct IPerlProc* piPerl) -{ - nw_abort(); -} - -char * -PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt) -{ - return nw_crypt(clear, salt); -} - -void -PerlProcExit(struct IPerlProc* piPerl, int status) -{ -// exit(status); - dTHX; - dJMPENV; - JMPENV_JUMP(2); -} - -void -PerlProc_Exit(struct IPerlProc* piPerl, int status) -{ -// _exit(status); - dTHX; - dJMPENV; - JMPENV_JUMP(2); -} - -int -PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) -{ - dTHXo; - Perl_croak(aTHX_ "execl not implemented!\n"); - return 0; -} - -int -PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv) -{ - return nw_execvp((char *)cmdname, (char **)argv); -} - -int -PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv) -{ - return nw_execvp((char *)cmdname, (char **)argv); -} - -uid_t -PerlProcGetuid(struct IPerlProc* piPerl) -{ - return 0; -} - -uid_t -PerlProcGeteuid(struct IPerlProc* piPerl) -{ - return 0; -} - -gid_t -PerlProcGetgid(struct IPerlProc* piPerl) -{ - return 0; -} - -gid_t -PerlProcGetegid(struct IPerlProc* piPerl) -{ - return 0; -} - -char * -PerlProcGetlogin(struct IPerlProc* piPerl) -{ - return NULL; -} - -int -PerlProcKill(struct IPerlProc* piPerl, int pid, int sig) -{ - return nw_kill(pid, sig); -} - -int -PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig) -{ - dTHXo; - Perl_croak(aTHX_ "killpg not implemented!\n"); - return 0; -} - -int -PerlProcPauseProc(struct IPerlProc* piPerl) -{ - return nw_sleep((32767L << 16) + 32767); -} - -PerlIO* -PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) -{ - dTHXo; - PERL_FLUSHALL_FOR_CHILD; - - return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno); -} - -int -PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream) -{ - return nw_Pclose((FILE*)stream, (int *)errno); -} - -int -PerlProcPipe(struct IPerlProc* piPerl, int *phandles) -{ - return nw_Pipe((int *)phandles, (int *)errno); -} - -int -PerlProcSetuid(struct IPerlProc* piPerl, uid_t u) -{ - return 0; -} - -int -PerlProcSetgid(struct IPerlProc* piPerl, gid_t g) -{ - return 0; -} - -int -PerlProcSleep(struct IPerlProc* piPerl, unsigned int s) -{ - return nw_sleep(s); -} - -int -PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf) -{ - return nw_times(timebuf); -} - -int -PerlProcWait(struct IPerlProc* piPerl, int *status) -{ - return nw_wait(status); -} - -int -PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags) -{ - return nw_waitpid(pid, status, flags); -} - -Sighandler_t -PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode) -{ - return 0; -} - -int -PerlProcFork(struct IPerlProc* piPerl) -{ - return 0; -} - -int -PerlProcGetpid(struct IPerlProc* piPerl) -{ - return nw_getpid(); -} - -/*BOOL -PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd) -{ - do_spawn2(cmd, EXECF_EXEC); - return FALSE; -}*/ - -int -PerlProcSpawn(struct IPerlProc* piPerl, char* cmds) -{ - return do_spawn2(cmds, EXECF_SPAWN); -} - -int -PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv) -{ - return nw_spawnvp(mode, (char *)cmdname, (char **)argv); -} - -int -PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp) -{ - return do_aspawn(vreally, vmark, vsp); -} - -/* IPerlProc - Process control functions - End =========================================*/ - -/* IPerlSock - Socket functions - Begin ==================================================*/ - -u_long -PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong) -{ - return(nw_htonl(hostlong)); -} - -u_short -PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort) -{ - return(nw_htons(hostshort)); -} - -u_long -PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong) -{ - return nw_ntohl(netlong); -} - -u_short -PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort) -{ - return nw_ntohs(netshort); -} - -SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen) -{ - return nw_accept(s, addr, addrlen); -} - -int -PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) -{ - return nw_bind(s, name, namelen); -} - -int -PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) -{ - return nw_connect(s, name, namelen); -} - -void -PerlSockEndhostent(struct IPerlSock* piPerl) -{ - nw_endhostent(); -} - -void -PerlSockEndnetent(struct IPerlSock* piPerl) -{ - nw_endnetent(); -} - -void -PerlSockEndprotoent(struct IPerlSock* piPerl) -{ - nw_endprotoent(); -} - -void -PerlSockEndservent(struct IPerlSock* piPerl) -{ - nw_endservent(); -} - -struct hostent* -PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type) -{ - return(nw_gethostbyaddr(addr,len,type)); -} - -struct hostent* -PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name) -{ - return nw_gethostbyname(name); -} - -struct hostent* -PerlSockGethostent(struct IPerlSock* piPerl) -{ - return(nw_gethostent()); -} - -int -PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen) -{ - return nw_gethostname(name,namelen); -} - -struct netent * -PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type) -{ - return nw_getnetbyaddr(net, type); -} - -struct netent * -PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name) -{ - return nw_getnetbyname((char*)name); -} - -struct netent * -PerlSockGetnetent(struct IPerlSock* piPerl) -{ - return nw_getnetent(); -} - -int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) -{ - return nw_getpeername(s, name, namelen); -} - -struct protoent* -PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name) -{ - return nw_getprotobyname(name); -} - -struct protoent* -PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number) -{ - return nw_getprotobynumber(number); -} - -struct protoent* -PerlSockGetprotoent(struct IPerlSock* piPerl) -{ - return nw_getprotoent(); -} - -struct servent* -PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto) -{ - return nw_getservbyname((char*)name, (char*)proto); -} - -struct servent* -PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto) -{ - return nw_getservbyport(port, proto); -} - -struct servent* -PerlSockGetservent(struct IPerlSock* piPerl) -{ - return nw_getservent(); -} - -int -PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) -{ - return nw_getsockname(s, name, namelen); -} - -int -PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen) -{ - return nw_getsockopt(s, level, optname, optval, optlen); -} - -unsigned long -PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp) -{ - return(nw_inet_addr(cp)); -} - -char* -PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in) -{ - return NULL; -} - -int -PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog) -{ - return (nw_listen(s, backlog)); -} - -int -PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags) -{ - return (nw_recv(s, buffer, len, flags)); -} - -int -PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) -{ - return nw_recvfrom(s, buffer, len, flags, from, fromlen); -} - -int -PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) -{ - return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout); -} - -int -PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags) -{ - return (nw_send(s, buffer, len, flags)); -} - -int -PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) -{ - return(nw_sendto(s, buffer, len, flags, to, tolen)); -} - -void -PerlSockSethostent(struct IPerlSock* piPerl, int stayopen) -{ - nw_sethostent(stayopen); -} - -void -PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen) -{ - nw_setnetent(stayopen); -} - -void -PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen) -{ - nw_setprotoent(stayopen); -} - -void -PerlSockSetservent(struct IPerlSock* piPerl, int stayopen) -{ - nw_setservent(stayopen); -} - -int -PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen) -{ - dTHXo; - Perl_croak(aTHX_ "setsockopt not implemented!\n"); - return 0; -} - -int -PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how) -{ - return nw_shutdown(s, how); -} - -SOCKET -PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol) -{ - return nw_socket(af, type, protocol); -} - -int -PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds) -{ - dTHXo; - Perl_croak(aTHX_ "socketpair not implemented!\n"); - return 0; -} +//CHKSGP +//Including this is giving premature end-of-file error during compilation +//#include "XSUB.h" -int -PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp) -{ - dTHXo; - Perl_croak(aTHX_ "ioctlsocket not implemented!\n"); - return 0; -} +#ifdef PERL_IMPLICIT_SYS -/* IPerlSock - Socket functions - End ==================================================*/ +//Includes iperlsys.h and function definitions +#include "nwperlsys.h" /*============================================================================================ @@ -1256,9 +87,8 @@ perl_alloc(void) WCValHashTable* m_allocList; m_allocList = new WCValHashTable (fnAllocListHash, 256); fnInsertHashListAddrs(m_allocList, FALSE); - my_perl = perl_alloc_using(&perlMem, - NULL, + &perlMem, NULL, &perlEnv, &perlStdIO, @@ -1267,16 +97,94 @@ perl_alloc(void) &perlSock, &perlProc); if (my_perl) { -#ifdef PERL_OBJECT - CPerlObj* pPerl = (CPerlObj*)my_perl; -#endif - //w32_internal_host = m_allocList; + //nw5_internal_host = m_allocList; } return my_perl; } /*============================================================================================ + Function : perl_alloc_override + + Description : creates a Perl interpreter variable and initializes + + Parameters : Pointer to structure containing function pointers + + Returns : Pointer to Perl interpreter + +==============================================================================================*/ +EXTERN_C PerlInterpreter* +perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) +{ + PerlInterpreter *my_perl = NULL; + + struct IPerlMem* lpMem; + struct IPerlEnv* lpEnv; + struct IPerlStdIO* lpStdio; + struct IPerlLIO* lpLIO; + struct IPerlDir* lpDir; + struct IPerlSock* lpSock; + struct IPerlProc* lpProc; + + WCValHashTable* m_allocList; + m_allocList = new WCValHashTable (fnAllocListHash, 256); + fnInsertHashListAddrs(m_allocList, FALSE); + + if (!ppMem) + lpMem=&perlMem; + else + lpMem=*ppMem; + + if (!ppEnv) + lpEnv=&perlEnv; + else + lpEnv=*ppEnv; + + if (!ppStdIO) + lpStdio=&perlStdIO; + else + lpStdio=*ppStdIO; + + if (!ppLIO) + lpLIO=&perlLIO; + else + lpLIO=*ppLIO; + + if (!ppDir) + lpDir=&perlDir; + else + lpDir=*ppDir; + + if (!ppSock) + lpSock=&perlSock; + else + lpSock=*ppSock; + + if (!ppProc) + lpProc=&perlProc; + else + lpProc=*ppProc; + my_perl = perl_alloc_using(lpMem, + lpMem, + NULL, + lpEnv, + lpStdio, + lpLIO, + lpDir, + lpSock, + lpProc); + + if (my_perl) { + //nw5_internal_host = pHost; + } + return my_perl; +} +/*============================================================================================ + Function : nw5_delete_internal_host Description : Deletes the alloc_list pointer