installperl Perl script to do "make install" dirty work
interp.sym Interpreter specific symbols to hide in a struct
intrpvar.h Variables held in each interpreter instance
-ipdir.h Directory interface for Perl Object
-ipenv.h Environment interface for Perl Object
-iplio.h Low level IO interface for Perl Object
-ipmem.h Memory interface for Perl Object
-ipproc.h Process interface for Perl Object
-ipsock.h Socket interface for Perl Object
-ipstdio.h Stdio interface for Perl Object
+iperlsys.h Perl's interface to the system
keywords.h The keyword numbers
keywords.pl Program to write keywords.h
lib/AnyDBM_File.pm Perl module to emulate dbmopen
perl.c main()
perl.h Global declarations
perl_exp.SH Creates list of exported symbols for AIX
-perldir.h Macros for directory abstraction
-perlenv.h Macros for environment abstraction
perlio.c C code for PerlIO abstraction
-perlio.h Interface to PerlIO abstraction
perlio.sym Symbols for PerlIO abstraction
-perllio.h Macros for Low level IO abstraction
-perlmem.h Macros for memory allocation abstraction
-perlproc.h Macros for process abstraction
perlsdio.h Fake stdio using perlio
perlsfio.h Prototype sfio mapping for PerlIO
perlsh A poor man's perl shell
-perlsock.h Macros for socket abstraction
perlvars.h Global variables
perly.c A byacc'ed perly.y
perly.c.diff Fixup perly.c to allow recursion
win32/makemain.pl Win32 port
win32/makeperldef.pl Win32 port
win32/perlglob.c Win32 port
+win32/perlhost.h Perl host implementation
win32/perllib.c Win32 port
win32/pod.mak Win32 port
win32/runperl.c Win32 port
+++ /dev/null
-/*
-
- ipdir.h
- Interface for perl directory functions
-
-*/
-
-
-/*
- PerlXXX_YYY explained - DickH and DougL @ ActiveState.com
-
-XXX := functional group
-YYY := stdlib/OS function name
-
-Continuing with the theme of PerlIO, all OS functionality was
-encapsulated into one of several interfaces.
-
-PerlIO - stdio
-PerlLIO - low level I/O
-PerlMem - malloc, realloc, free
-PerlDir - directory related
-PerlEnv - process environment handling
-PerlProc - process control
-PerlSock - socket functions
-
-
-The features of this are:
-1. All OS dependant code is in the Perl Host and not the Perl Core.
- (At least this is the holy grail goal of this work)
-2. The Perl Host (see perl.h for description) can provide a new and
- improved interface to OS functionality if required.
-3. Developers can easily hook into the OS calls for instrumentation
- or diagnostic purposes.
-
-What was changed to do this:
-1. All calls to OS functions were replaced with PerlXXX_YYY
-
-*/
-
-
-
-#ifndef __Inc__IPerlDir___
-#define __Inc__IPerlDir___
-
-class IPerlDir
-{
-public:
- virtual int Makedir(const char *dirname, int mode, int &err) = 0;
- virtual int Chdir(const char *dirname, int &err) = 0;
- virtual int Rmdir(const char *dirname, int &err) = 0;
- virtual int Close(DIR *dirp, int &err) = 0;
- virtual DIR *Open(char *filename, int &err) = 0;
- virtual struct direct *Read(DIR *dirp, int &err) = 0;
- virtual void Rewind(DIR *dirp, int &err) = 0;
- virtual void Seek(DIR *dirp, long loc, int &err) = 0;
- virtual long Tell(DIR *dirp, int &err) = 0;
-};
-
-#endif /* __Inc__IPerlDir___ */
-
+++ /dev/null
-/*
-
- ipenv.h
- Interface for perl environment functions
-
-*/
-
-#ifndef __Inc__IPerlEnv___
-#define __Inc__IPerlEnv___
-
-class IPerlEnv
-{
-public:
- virtual char* Getenv(const char *varname, int &err) = 0;
- virtual int Putenv(const char *envstring, int &err) = 0;
- virtual char* LibPath(char *patchlevel) =0;
- virtual char* SiteLibPath(char *patchlevel) =0;
-};
-
-#endif /* __Inc__IPerlEnv___ */
-
--- /dev/null
+/*
+ * iperlsys.h - Perl's interface to the system
+ *
+ * This file defines the system level functionality that perl needs.
+ *
+ * When using C, this definition is in the form of a set of macros
+ * that can be #defined to the system-level function (or a wrapper
+ * provided elsewhere).
+ *
+ * When using C++ with -DPERL_OBJECT, this definition is in the
+ * form of a set of virtual base classes which must be subclassed to
+ * provide a real implementation. The Perl Object will use instances
+ * of this implementation to use the system-level functionality.
+ *
+ * GSAR 21-JUN-98
+ */
+
+#ifndef __Inc__IPerl___
+#define __Inc__IPerl___
+
+/*
+ * PerlXXX_YYY explained - DickH and DougL @ ActiveState.com
+ *
+ * XXX := functional group
+ * YYY := stdlib/OS function name
+ *
+ * Continuing with the theme of PerlIO, all OS functionality was
+ * encapsulated into one of several interfaces.
+ *
+ * PerlIO - stdio
+ * PerlLIO - low level I/O
+ * PerlMem - malloc, realloc, free
+ * PerlDir - directory related
+ * PerlEnv - process environment handling
+ * PerlProc - process control
+ * PerlSock - socket functions
+ *
+ *
+ * The features of this are:
+ * 1. All OS dependant code is in the Perl Host and not the Perl Core.
+ * (At least this is the holy grail goal of this work)
+ * 2. The Perl Host (see perl.h for description) can provide a new and
+ * improved interface to OS functionality if required.
+ * 3. Developers can easily hook into the OS calls for instrumentation
+ * or diagnostic purposes.
+ *
+ * What was changed to do this:
+ * 1. All calls to OS functions were replaced with PerlXXX_YYY
+ *
+ */
+
+
+/*
+ Interface for perl stdio functions
+*/
+
+
+/* Clean up (or at least document) the various possible #defines.
+ This section attempts to match the 5.003_03 Configure variables
+ onto the 5.003_02 header file values.
+ I can't figure out where USE_STDIO was supposed to be set.
+ --AD
+*/
+#ifndef USE_PERLIO
+# define PERLIO_IS_STDIO
+#endif
+
+/* Below is the 5.003_02 stuff. */
+#ifdef USE_STDIO
+# ifndef PERLIO_IS_STDIO
+# define PERLIO_IS_STDIO
+# endif
+#else
+extern void PerlIO_init _((void));
+#endif
+
+#ifdef PERL_OBJECT
+
+#ifndef PerlIO
+typedef struct _PerlIO PerlIO;
+#endif
+
+class IPerlStdIO
+{
+public:
+ virtual PerlIO * Stdin(void) = 0;
+ virtual PerlIO * Stdout(void) = 0;
+ virtual PerlIO * Stderr(void) = 0;
+ virtual PerlIO * Open(const char *, const char *, int &err) = 0;
+ virtual int Close(PerlIO*, int &err) = 0;
+ virtual int Eof(PerlIO*, int &err) = 0;
+ virtual int Error(PerlIO*, int &err) = 0;
+ virtual void Clearerr(PerlIO*, int &err) = 0;
+ virtual int Getc(PerlIO*, int &err) = 0;
+ virtual char * GetBase(PerlIO *, int &err) = 0;
+ virtual int GetBufsiz(PerlIO *, int &err) = 0;
+ virtual int GetCnt(PerlIO *, int &err) = 0;
+ virtual char * GetPtr(PerlIO *, int &err) = 0;
+ virtual char * Gets(PerlIO*, char*, int, int& err) = 0;
+ virtual int Putc(PerlIO*, int, int &err) = 0;
+ virtual int Puts(PerlIO*, const char *, int &err) = 0;
+ virtual int Flush(PerlIO*, int &err) = 0;
+ virtual int Ungetc(PerlIO*,int, int &err) = 0;
+ virtual int Fileno(PerlIO*, int &err) = 0;
+ virtual PerlIO * Fdopen(int, const char *, int &err) = 0;
+ virtual PerlIO * Reopen(const char*, const char*, PerlIO*, int &err) = 0;
+ virtual SSize_t Read(PerlIO*,void *,Size_t, int &err) = 0;
+ virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err) = 0;
+ virtual void SetBuf(PerlIO *, char*, int &err) = 0;
+ virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err) = 0;
+ virtual void SetCnt(PerlIO *, int, int &err) = 0;
+ virtual void SetPtrCnt(PerlIO *, char *, int, int& err) = 0;
+ virtual void Setlinebuf(PerlIO*, int &err) = 0;
+ virtual int Printf(PerlIO*, int &err, const char *,...) = 0;
+ virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0;
+ virtual long Tell(PerlIO*, int &err) = 0;
+ virtual int Seek(PerlIO*, off_t, int, int &err) = 0;
+ virtual void Rewind(PerlIO*, int &err) = 0;
+ virtual PerlIO * Tmpfile(int &err) = 0;
+ virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0;
+ virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0;
+ virtual void Init(int &err) = 0;
+ virtual void InitOSExtras(void* p) = 0;
+#ifdef WIN32
+ virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
+ virtual int GetOSfhandle(int filenum) = 0;
+#endif
+};
+
+#define PerlIO_canset_cnt(f) 1
+#define PerlIO_has_base(f) 1
+#define PerlIO_has_cntptr(f) 1
+#define PerlIO_fast_gets(f) 1
+
+#define PerlIO_stdin() piStdIO->Stdin()
+#define PerlIO_stdout() piStdIO->Stdout()
+#define PerlIO_stderr() piStdIO->Stderr()
+#define PerlIO_open(x,y) piStdIO->Open((x),(y), ErrorNo())
+#define PerlIO_close(f) piStdIO->Close((f), ErrorNo())
+#define PerlIO_eof(f) piStdIO->Eof((f), ErrorNo())
+#define PerlIO_error(f) piStdIO->Error((f), ErrorNo())
+#define PerlIO_clearerr(f) piStdIO->Clearerr((f), ErrorNo())
+#define PerlIO_getc(f) piStdIO->Getc((f), ErrorNo())
+#define PerlIO_get_base(f) piStdIO->GetBase((f), ErrorNo())
+#define PerlIO_get_bufsiz(f) piStdIO->GetBufsiz((f), ErrorNo())
+#define PerlIO_get_cnt(f) piStdIO->GetCnt((f), ErrorNo())
+#define PerlIO_get_ptr(f) piStdIO->GetPtr((f), ErrorNo())
+#define PerlIO_putc(f,c) piStdIO->Putc((f),(c), ErrorNo())
+#define PerlIO_puts(f,s) piStdIO->Puts((f),(s), ErrorNo())
+#define PerlIO_flush(f) piStdIO->Flush((f), ErrorNo())
+#define PerlIO_gets(s, n, fp) piStdIO->Gets((fp), s, n, ErrorNo())
+#define PerlIO_ungetc(f,c) piStdIO->Ungetc((f),(c), ErrorNo())
+#define PerlIO_fileno(f) piStdIO->Fileno((f), ErrorNo())
+#define PerlIO_fdopen(f, s) piStdIO->Fdopen((f),(s), ErrorNo())
+#define PerlIO_reopen(p, m, f) piStdIO->Reopen((p), (m), (f), ErrorNo())
+#define PerlIO_read(f,buf,count) \
+ (SSize_t)piStdIO->Read((f), (buf), (count), ErrorNo())
+#define PerlIO_write(f,buf,count) \
+ piStdIO->Write((f), (buf), (count), ErrorNo())
+#define PerlIO_setbuf(f,b) piStdIO->SetBuf((f), (b), ErrorNo())
+#define PerlIO_setvbuf(f,b,t,s) piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo())
+#define PerlIO_set_cnt(f,c) piStdIO->SetCnt((f), (c), ErrorNo())
+#define PerlIO_set_ptrcnt(f,p,c) \
+ piStdIO->SetPtrCnt((f), (p), (c), ErrorNo())
+#define PerlIO_setlinebuf(f) piStdIO->Setlinebuf((f), ErrorNo())
+#define PerlIO_printf fprintf
+#define PerlIO_stdoutf piStdIO->Printf
+#define PerlIO_vprintf(f,fmt,a) piStdIO->Vprintf((f), ErrorNo(), (fmt),a)
+#define PerlIO_tell(f) piStdIO->Tell((f), ErrorNo())
+#define PerlIO_seek(f,o,w) piStdIO->Seek((f),(o),(w), ErrorNo())
+#define PerlIO_getpos(f,p) piStdIO->Getpos((f),(p), ErrorNo())
+#define PerlIO_setpos(f,p) piStdIO->Setpos((f),(p), ErrorNo())
+#define PerlIO_rewind(f) piStdIO->Rewind((f), ErrorNo())
+#define PerlIO_tmpfile() piStdIO->Tmpfile(ErrorNo())
+#define PerlIO_init() piStdIO->Init(ErrorNo())
+#undef init_os_extras
+#define init_os_extras() piStdIO->InitOSExtras(this)
+
+#else /* PERL_OBJECT */
+
+#include "perlsdio.h"
+
+#endif /* PERL_OBJECT */
+
+#ifndef PERLIO_IS_STDIO
+#ifdef USE_SFIO
+#include "perlsfio.h"
+#endif /* USE_SFIO */
+#endif /* PERLIO_IS_STDIO */
+
+#ifndef EOF
+#define EOF (-1)
+#endif
+
+/* This is to catch case with no stdio */
+#ifndef BUFSIZ
+#define BUFSIZ 1024
+#endif
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#endif
+
+#ifndef SEEK_CUR
+#define SEEK_CUR 1
+#endif
+
+#ifndef SEEK_END
+#define SEEK_END 2
+#endif
+
+#ifndef PerlIO
+struct _PerlIO;
+#define PerlIO struct _PerlIO
+#endif /* No PerlIO */
+
+#ifndef Fpos_t
+#define Fpos_t long
+#endif
+
+#ifndef NEXT30_NO_ATTRIBUTE
+#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */
+#ifdef __attribute__ /* Avoid possible redefinition errors */
+#undef __attribute__
+#endif
+#define __attribute__(attr)
+#endif
+#endif
+
+#ifndef PerlIO_stdoutf
+extern int PerlIO_stdoutf _((const char *,...))
+ __attribute__((format (printf, 1, 2)));
+#endif
+#ifndef PerlIO_puts
+extern int PerlIO_puts _((PerlIO *,const char *));
+#endif
+#ifndef PerlIO_open
+extern PerlIO * PerlIO_open _((const char *,const char *));
+#endif
+#ifndef PerlIO_close
+extern int PerlIO_close _((PerlIO *));
+#endif
+#ifndef PerlIO_eof
+extern int PerlIO_eof _((PerlIO *));
+#endif
+#ifndef PerlIO_error
+extern int PerlIO_error _((PerlIO *));
+#endif
+#ifndef PerlIO_clearerr
+extern void PerlIO_clearerr _((PerlIO *));
+#endif
+#ifndef PerlIO_getc
+extern int PerlIO_getc _((PerlIO *));
+#endif
+#ifndef PerlIO_putc
+extern int PerlIO_putc _((PerlIO *,int));
+#endif
+#ifndef PerlIO_flush
+extern int PerlIO_flush _((PerlIO *));
+#endif
+#ifndef PerlIO_ungetc
+extern int PerlIO_ungetc _((PerlIO *,int));
+#endif
+#ifndef PerlIO_fileno
+extern int PerlIO_fileno _((PerlIO *));
+#endif
+#ifndef PerlIO_fdopen
+extern PerlIO * PerlIO_fdopen _((int, const char *));
+#endif
+#ifndef PerlIO_importFILE
+extern PerlIO * PerlIO_importFILE _((FILE *,int));
+#endif
+#ifndef PerlIO_exportFILE
+extern FILE * PerlIO_exportFILE _((PerlIO *,int));
+#endif
+#ifndef PerlIO_findFILE
+extern FILE * PerlIO_findFILE _((PerlIO *));
+#endif
+#ifndef PerlIO_releaseFILE
+extern void PerlIO_releaseFILE _((PerlIO *,FILE *));
+#endif
+#ifndef PerlIO_read
+extern SSize_t PerlIO_read _((PerlIO *,void *,Size_t));
+#endif
+#ifndef PerlIO_write
+extern SSize_t PerlIO_write _((PerlIO *,const void *,Size_t));
+#endif
+#ifndef PerlIO_setlinebuf
+extern void PerlIO_setlinebuf _((PerlIO *));
+#endif
+#ifndef PerlIO_printf
+extern int PerlIO_printf _((PerlIO *, const char *,...))
+ __attribute__((format (printf, 2, 3)));
+#endif
+#ifndef PerlIO_sprintf
+extern int PerlIO_sprintf _((char *, int, const char *,...))
+ __attribute__((format (printf, 3, 4)));
+#endif
+#ifndef PerlIO_vprintf
+extern int PerlIO_vprintf _((PerlIO *, const char *, va_list));
+#endif
+#ifndef PerlIO_tell
+extern long PerlIO_tell _((PerlIO *));
+#endif
+#ifndef PerlIO_seek
+extern int PerlIO_seek _((PerlIO *,off_t,int));
+#endif
+#ifndef PerlIO_rewind
+extern void PerlIO_rewind _((PerlIO *));
+#endif
+#ifndef PerlIO_has_base
+extern int PerlIO_has_base _((PerlIO *));
+#endif
+#ifndef PerlIO_has_cntptr
+extern int PerlIO_has_cntptr _((PerlIO *));
+#endif
+#ifndef PerlIO_fast_gets
+extern int PerlIO_fast_gets _((PerlIO *));
+#endif
+#ifndef PerlIO_canset_cnt
+extern int PerlIO_canset_cnt _((PerlIO *));
+#endif
+#ifndef PerlIO_get_ptr
+extern STDCHAR * PerlIO_get_ptr _((PerlIO *));
+#endif
+#ifndef PerlIO_get_cnt
+extern int PerlIO_get_cnt _((PerlIO *));
+#endif
+#ifndef PerlIO_set_cnt
+extern void PerlIO_set_cnt _((PerlIO *,int));
+#endif
+#ifndef PerlIO_set_ptrcnt
+extern void PerlIO_set_ptrcnt _((PerlIO *,STDCHAR *,int));
+#endif
+#ifndef PerlIO_get_base
+extern STDCHAR * PerlIO_get_base _((PerlIO *));
+#endif
+#ifndef PerlIO_get_bufsiz
+extern int PerlIO_get_bufsiz _((PerlIO *));
+#endif
+#ifndef PerlIO_tmpfile
+extern PerlIO * PerlIO_tmpfile _((void));
+#endif
+#ifndef PerlIO_stdin
+extern PerlIO * PerlIO_stdin _((void));
+#endif
+#ifndef PerlIO_stdout
+extern PerlIO * PerlIO_stdout _((void));
+#endif
+#ifndef PerlIO_stderr
+extern PerlIO * PerlIO_stderr _((void));
+#endif
+#ifndef PerlIO_getpos
+extern int PerlIO_getpos _((PerlIO *,Fpos_t *));
+#endif
+#ifndef PerlIO_setpos
+extern int PerlIO_setpos _((PerlIO *,const Fpos_t *));
+#endif
+
+
+/*
+ * Interface for directory functions
+ */
+
+#ifdef PERL_OBJECT
+
+class IPerlDir
+{
+public:
+ virtual int Makedir(const char *dirname, int mode, int &err) = 0;
+ virtual int Chdir(const char *dirname, int &err) = 0;
+ virtual int Rmdir(const char *dirname, int &err) = 0;
+ virtual int Close(DIR *dirp, int &err) = 0;
+ virtual DIR * Open(char *filename, int &err) = 0;
+ virtual struct direct *Read(DIR *dirp, int &err) = 0;
+ virtual void Rewind(DIR *dirp, int &err) = 0;
+ virtual void Seek(DIR *dirp, long loc, int &err) = 0;
+ virtual long Tell(DIR *dirp, int &err) = 0;
+};
+
+#define PerlDir_mkdir(name, mode) \
+ piDir->Makedir((name), (mode), ErrorNo())
+#define PerlDir_chdir(name) \
+ piDir->Chdir((name), ErrorNo())
+#define PerlDir_rmdir(name) \
+ piDir->Rmdir((name), ErrorNo())
+#define PerlDir_close(dir) \
+ piDir->Close((dir), ErrorNo())
+#define PerlDir_open(name) \
+ piDir->Open((name), ErrorNo())
+#define PerlDir_read(dir) \
+ piDir->Read((dir), ErrorNo())
+#define PerlDir_rewind(dir) \
+ piDir->Rewind((dir), ErrorNo())
+#define PerlDir_seek(dir, loc) \
+ piDir->Seek((dir), (loc), ErrorNo())
+#define PerlDir_tell(dir) \
+ piDir->Tell((dir), ErrorNo())
+
+#else /* PERL_OBJECT */
+
+#define PerlDir_mkdir(name, mode) Mkdir((name), (mode))
+#ifdef VMS
+# define PerlDir_chdir(n) chdir(((n) && *(n)) ? (n) : "SYS$LOGIN")
+#else
+# define PerlDir_chdir(name) chdir((name))
+#endif
+#define PerlDir_rmdir(name) rmdir((name))
+#define PerlDir_close(dir) closedir((dir))
+#define PerlDir_open(name) opendir((name))
+#define PerlDir_read(dir) readdir((dir))
+#define PerlDir_rewind(dir) rewinddir((dir))
+#define PerlDir_seek(dir, loc) seekdir((dir), (loc))
+#define PerlDir_tell(dir) telldir((dir))
+
+#endif /* PERL_OBJECT */
+
+/*
+ Interface for perl environment functions
+*/
+
+#ifdef PERL_OBJECT
+
+class IPerlEnv
+{
+public:
+ virtual char * Getenv(const char *varname, int &err) = 0;
+ virtual int Putenv(const char *envstring, int &err) = 0;
+ virtual char * LibPath(char *patchlevel) =0;
+ virtual char * SiteLibPath(char *patchlevel) =0;
+};
+
+#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo())
+#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo())
+#ifdef WIN32
+#define PerlEnv_lib_path(str) piENV->LibPath((str))
+#define PerlEnv_sitelib_path(str) piENV->SiteLibPath((str))
+#endif
+
+#else /* PERL_OBJECT */
+
+#define PerlEnv_putenv(str) putenv((str))
+#define PerlEnv_getenv(str) getenv((str))
+
+#endif /* PERL_OBJECT */
+
+/*
+ Interface for perl low-level IO functions
+*/
+
+#ifdef PERL_OBJECT
+
+class IPerlLIO
+{
+public:
+ virtual int Access(const char *path, int mode, int &err) = 0;
+ virtual int Chmod(const char *filename, int pmode, int &err) = 0;
+ virtual int Chown(const char *filename, uid_t owner,
+ gid_t group, int &err) = 0;
+ virtual int Chsize(int handle, long size, int &err) = 0;
+ virtual int Close(int handle, int &err) = 0;
+ virtual int Dup(int handle, int &err) = 0;
+ virtual int Dup2(int handle1, int handle2, int &err) = 0;
+ virtual int Flock(int fd, int oper, int &err) = 0;
+ virtual int FileStat(int handle, struct stat *buffer, int &err) = 0;
+ virtual int IOCtl(int i, unsigned int u, char *data, int &err) = 0;
+ virtual int Isatty(int handle, int &err) = 0;
+ virtual long Lseek(int handle, long offset, int origin, int &err) = 0;
+ virtual int Lstat(const char *path, struct stat *buffer, int &err) = 0;
+ virtual char * Mktemp(char *Template, int &err) = 0;
+ virtual int Open(const char *filename, int oflag, int &err) = 0;
+ virtual int Open(const char *filename, int oflag,
+ int pmode, int &err) = 0;
+ virtual int Read(int handle, void *buffer,
+ unsigned int count, int &err) = 0;
+ virtual int Rename(const char *oldname,
+ const char *newname, int &err) = 0;
+ virtual int Setmode(int handle, int mode, int &err) = 0;
+ virtual int NameStat(const char *path,
+ struct stat *buffer, int &err) = 0;
+ virtual char * Tmpnam(char *string, int &err) = 0;
+ virtual int Umask(int pmode, int &err) = 0;
+ virtual int Unlink(const char *filename, int &err) = 0;
+ virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0;
+ virtual int Write(int handle, const void *buffer,
+ unsigned int count, int &err) = 0;
+};
+
+#define PerlLIO_access(file, mode) \
+ piLIO->Access((file), (mode), ErrorNo())
+#define PerlLIO_chmod(file, mode) \
+ piLIO->Chmod((file), (mode), ErrorNo())
+#define PerlLIO_chown(file, owner, group) \
+ piLIO->Chown((file), (owner), (group), ErrorNo())
+#define PerlLIO_chsize(fd, size) \
+ piLIO->Chsize((fd), (size), ErrorNo())
+#define PerlLIO_close(fd) \
+ piLIO->Close((fd), ErrorNo())
+#define PerlLIO_dup(fd) \
+ piLIO->Dup((fd), ErrorNo())
+#define PerlLIO_dup2(fd1, fd2) \
+ piLIO->Dup2((fd1), (fd2), ErrorNo())
+#define PerlLIO_flock(fd, op) \
+ piLIO->Flock((fd), (op), ErrorNo())
+#define PerlLIO_fstat(fd, buf) \
+ piLIO->FileStat((fd), (buf), ErrorNo())
+#define PerlLIO_ioctl(fd, u, buf) \
+ piLIO->IOCtl((fd), (u), (buf), ErrorNo())
+#define PerlLIO_isatty(fd) \
+ piLIO->Isatty((fd), ErrorNo())
+#define PerlLIO_lseek(fd, offset, mode) \
+ piLIO->Lseek((fd), (offset), (mode), ErrorNo())
+#define PerlLIO_lstat(name, buf) \
+ piLIO->Lstat((name), (buf), ErrorNo())
+#define PerlLIO_mktemp(file) \
+ piLIO->Mktemp((file), ErrorNo())
+#define PerlLIO_open(file, flag) \
+ piLIO->Open((file), (flag), ErrorNo())
+#define PerlLIO_open3(file, flag, perm) \
+ piLIO->Open((file), (flag), (perm), ErrorNo())
+#define PerlLIO_read(fd, buf, count) \
+ piLIO->Read((fd), (buf), (count), ErrorNo())
+#define PerlLIO_rename(oldname, newname) \
+ piLIO->Rename((oldname), (newname), ErrorNo())
+#define PerlLIO_setmode(fd, mode) \
+ piLIO->Setmode((fd), (mode), ErrorNo())
+#define PerlLIO_stat(name, buf) \
+ piLIO->NameStat((name), (buf), ErrorNo())
+#define PerlLIO_tmpnam(str) \
+ piLIO->Tmpnam((str), ErrorNo())
+#define PerlLIO_umask(mode) \
+ piLIO->Umask((mode), ErrorNo())
+#define PerlLIO_unlink(file) \
+ piLIO->Unlink((file), ErrorNo())
+#define PerlLIO_utime(file, time) \
+ piLIO->Utime((file), (time), ErrorNo())
+#define PerlLIO_write(fd, buf, count) \
+ piLIO->Write((fd), (buf), (count), ErrorNo())
+
+#else /* PERL_OBJECT */
+
+#define PerlLIO_access(file, mode) access((file), (mode))
+#define PerlLIO_chmod(file, mode) chmod((file), (mode))
+#define PerlLIO_chown(file, owner, grp) chown((file), (owner), (grp))
+#define PerlLIO_chsize(fd, size) chsize((fd), (size))
+#define PerlLIO_close(fd) close((fd))
+#define PerlLIO_dup(fd) dup((fd))
+#define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2))
+#define PerlLIO_flock(fd, op) FLOCK((fd), (op))
+#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf))
+#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf))
+#define PerlLIO_isatty(fd) isatty((fd))
+#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode))
+#define PerlLIO_lstat(name, buf) lstat((name), (buf))
+#define PerlLIO_mktemp(file) mktemp((file))
+#define PerlLIO_mkstemp(file) mkstemp((file))
+#define PerlLIO_open(file, flag) open((file), (flag))
+#define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm))
+#define PerlLIO_read(fd, buf, count) read((fd), (buf), (count))
+#define PerlLIO_rename(old, new) rename((old), (new))
+#define PerlLIO_setmode(fd, mode) setmode((fd), (mode))
+#define PerlLIO_stat(name, buf) Stat((name), (buf))
+#define PerlLIO_tmpnam(str) tmpnam((str))
+#define PerlLIO_umask(mode) umask((mode))
+#define PerlLIO_unlink(file) unlink((file))
+#define PerlLIO_utime(file, time) utime((file), (time))
+#define PerlLIO_write(fd, buf, count) write((fd), (buf), (count))
+
+#endif /* PERL_OBJECT */
+
+/*
+ Interface for perl memory allocation
+*/
+
+#ifdef PERL_OBJECT
+
+class IPerlMem
+{
+public:
+ virtual void * Malloc(size_t) = 0;
+ virtual void * Realloc(void*, size_t) = 0;
+ virtual void Free(void*) = 0;
+};
+
+#define PerlMem_malloc(size) piMem->Malloc((size))
+#define PerlMem_realloc(buf, size) piMem->Realloc((buf), (size))
+#define PerlMem_free(buf) piMem->Free((buf))
+
+#else /* PERL_OBJECT */
+
+#define PerlMem_malloc(size) malloc((size))
+#define PerlMem_realloc(buf, size) realloc((buf), (size))
+#define PerlMem_free(buf) free((buf))
+
+#endif /* PERL_OBJECT */
+
+/*
+ Interface for perl process functions
+*/
+
+
+#ifdef PERL_OBJECT
+
+#ifndef Sighandler_t
+typedef Signal_t (*Sighandler_t) _((int));
+#endif
+#ifndef jmp_buf
+#include <setjmp.h>
+#endif
+
+class IPerlProc
+{
+public:
+ virtual void Abort(void) = 0;
+ virtual void Exit(int status) = 0;
+ virtual void _Exit(int status) = 0;
+ virtual int Execl(const char *cmdname, const char *arg0,
+ const char *arg1, const char *arg2,
+ const char *arg3) = 0;
+ virtual int Execv(const char *cmdname, const char *const *argv) = 0;
+ virtual int Execvp(const char *cmdname, const char *const *argv) = 0;
+ virtual uid_t Getuid(void) = 0;
+ virtual uid_t Geteuid(void) = 0;
+ virtual gid_t Getgid(void) = 0;
+ virtual gid_t Getegid(void) = 0;
+ virtual char * Getlogin(void) = 0;
+ virtual int Kill(int pid, int sig) = 0;
+ virtual int Killpg(int pid, int sig) = 0;
+ virtual int PauseProc(void) = 0;
+ virtual PerlIO * Popen(const char *command, const char *mode) = 0;
+ virtual int Pclose(PerlIO *stream) = 0;
+ virtual int Pipe(int *phandles) = 0;
+ virtual int Setuid(uid_t uid) = 0;
+ virtual int Setgid(gid_t gid) = 0;
+ virtual int Sleep(unsigned int) = 0;
+ virtual int Times(struct tms *timebuf) = 0;
+ virtual int Wait(int *status) = 0;
+ virtual int Waitpid(int pid, int *status, int flags) = 0;
+ virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0;
+#ifdef WIN32
+ virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0;
+ virtual void FreeBuf(char* msg) = 0;
+ virtual BOOL DoCmd(char *cmd) = 0;
+ virtual int Spawn(char*cmds) = 0;
+ virtual int Spawnvp(int mode, const char *cmdname,
+ const char *const *argv) = 0;
+ virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0;
+#endif
+};
+
+#define PerlProc_abort() piProc->Abort()
+#define PerlProc_exit(s) piProc->Exit((s))
+#define PerlProc__exit(s) piProc->_Exit((s))
+#define PerlProc_execl(c, w, x, y, z) \
+ piProc->Execl((c), (w), (x), (y), (z))
+
+#define PerlProc_execv(c, a) piProc->Execv((c), (a))
+#define PerlProc_execvp(c, a) piProc->Execvp((c), (a))
+#define PerlProc_getuid() piProc->Getuid()
+#define PerlProc_geteuid() piProc->Geteuid()
+#define PerlProc_getgid() piProc->Getgid()
+#define PerlProc_getegid() piProc->Getegid()
+#define PerlProc_getlogin() piProc->Getlogin()
+#define PerlProc_kill(i, a) piProc->Kill((i), (a))
+#define PerlProc_killpg(i, a) piProc->Killpg((i), (a))
+#define PerlProc_pause() piProc->PauseProc()
+#define PerlProc_popen(c, m) piProc->Popen((c), (m))
+#define PerlProc_pclose(f) piProc->Pclose((f))
+#define PerlProc_pipe(fd) piProc->Pipe((fd))
+#define PerlProc_setuid(u) piProc->Setuid((u))
+#define PerlProc_setgid(g) piProc->Setgid((g))
+#define PerlProc_sleep(t) piProc->Sleep((t))
+#define PerlProc_times(t) piProc->Times((t))
+#define PerlProc_wait(t) piProc->Wait((t))
+#define PerlProc_waitpid(p,s,f) piProc->Waitpid((p), (s), (f))
+#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
+#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
+#define PerlProc_signal(n, h) piProc->Signal((n), (h))
+
+#ifdef WIN32
+#define PerlProc_GetSysMsg(s,l,e) \
+ piProc->GetSysMsg((s), (l), (e))
+
+#define PerlProc_FreeBuf(s) piProc->FreeBuf((s))
+#define PerlProc_Cmd(s) piProc->DoCmd((s))
+#define do_spawn(s) piProc->Spawn((s))
+#define do_spawnvp(m, c, a) piProc->Spawnvp((m), (c), (a))
+#define PerlProc_aspawn(m,c,a) piProc->ASpawn((m), (c), (a))
+#endif
+
+#else /* PERL_OBJECT */
+
+#define PerlProc_abort() abort()
+#define PerlProc_exit(s) exit((s))
+#define PerlProc__exit(s) _exit((s))
+#define PerlProc_execl(c,w,x,y,z) \
+ execl((c), (w), (x), (y), (z))
+#define PerlProc_execv(c, a) execv((c), (a))
+#define PerlProc_execvp(c, a) execvp((c), (a))
+#define PerlProc_getuid() getuid()
+#define PerlProc_geteuid() geteuid()
+#define PerlProc_getgid() getgid()
+#define PerlProc_getegid() getegid()
+#define PerlProc_getlogin() getlogin()
+#define PerlProc_kill(i, a) kill((i), (a))
+#define PerlProc_killpg(i, a) killpg((i), (a))
+#define PerlProc_pause() Pause()
+#define PerlProc_popen(c, m) my_popen((c), (m))
+#define PerlProc_pclose(f) my_pclose((f))
+#define PerlProc_pipe(fd) pipe((fd))
+#define PerlProc_setuid(u) setuid((u))
+#define PerlProc_setgid(g) setgid((g))
+#define PerlProc_sleep(t) sleep((t))
+#define PerlProc_times(t) times((t))
+#define PerlProc_wait(t) wait((t))
+#define PerlProc_waitpid(p,s,f) waitpid((p), (s), (f))
+#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
+#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
+#define PerlProc_signal(n, h) signal((n), (h))
+
+
+#endif /* PERL_OBJECT */
+
+/*
+ Interface for perl socket functions
+*/
+
+#ifdef PERL_OBJECT
+
+class IPerlSock
+{
+public:
+ virtual u_long Htonl(u_long hostlong) = 0;
+ virtual u_short Htons(u_short hostshort) = 0;
+ virtual u_long Ntohl(u_long netlong) = 0;
+ virtual u_short Ntohs(u_short netshort) = 0;
+ virtual SOCKET Accept(SOCKET s, struct sockaddr* addr,
+ int* addrlen, int &err) = 0;
+ virtual int Bind(SOCKET s, const struct sockaddr* name,
+ int namelen, int &err) = 0;
+ virtual int Connect(SOCKET s, const struct sockaddr* name,
+ int namelen, int &err) = 0;
+ virtual void Endhostent(int &err) = 0;
+ virtual void Endnetent(int &err) = 0;
+ virtual void Endprotoent(int &err) = 0;
+ virtual void Endservent(int &err) = 0;
+ virtual int Gethostname(char* name, int namelen, int &err) = 0;
+ virtual int Getpeername(SOCKET s, struct sockaddr* name,
+ int* namelen, int &err) = 0;
+ virtual struct hostent * Gethostbyaddr(const char* addr, int len,
+ int type, int &err) = 0;
+ virtual struct hostent * Gethostbyname(const char* name, int &err) = 0;
+ virtual struct hostent * Gethostent(int &err) = 0;
+ virtual struct netent * Getnetbyaddr(long net, int type, int &err) = 0;
+ virtual struct netent * Getnetbyname(const char *, int &err) = 0;
+ virtual struct netent * Getnetent(int &err) = 0;
+ virtual struct protoent * Getprotobyname(const char* name, int &err) = 0;
+ virtual struct protoent * Getprotobynumber(int number, int &err) = 0;
+ virtual struct protoent * Getprotoent(int &err) = 0;
+ virtual struct servent * Getservbyname(const char* name,
+ const char* proto, int &err) = 0;
+ virtual struct servent * Getservbyport(int port, const char* proto,
+ int &err) = 0;
+ virtual struct servent * Getservent(int &err) = 0;
+ virtual int Getsockname(SOCKET s, struct sockaddr* name,
+ int* namelen, int &err) = 0;
+ virtual int Getsockopt(SOCKET s, int level, int optname,
+ char* optval, int* optlen, int &err) = 0;
+ virtual unsigned long InetAddr(const char* cp, int &err) = 0;
+ virtual char * InetNtoa(struct in_addr in, int &err) = 0;
+ virtual int Listen(SOCKET s, int backlog, int &err) = 0;
+ virtual int Recv(SOCKET s, char* buf, int len,
+ int flags, int &err) = 0;
+ virtual int Recvfrom(SOCKET s, char* buf, int len, int flags,
+ struct sockaddr* from, int* fromlen, int &err) = 0;
+ virtual int Select(int nfds, char* readfds, char* writefds,
+ char* exceptfds, const struct timeval* timeout,
+ int &err) = 0;
+ virtual int Send(SOCKET s, const char* buf, int len,
+ int flags, int &err) = 0;
+ virtual int Sendto(SOCKET s, const char* buf, int len, int flags,
+ const struct sockaddr* to, int tolen, int &err) = 0;
+ virtual void Sethostent(int stayopen, int &err) = 0;
+ virtual void Setnetent(int stayopen, int &err) = 0;
+ virtual void Setprotoent(int stayopen, int &err) = 0;
+ virtual void Setservent(int stayopen, int &err) = 0;
+ virtual int Setsockopt(SOCKET s, int level, int optname,
+ const char* optval, int optlen, int &err) = 0;
+ virtual int Shutdown(SOCKET s, int how, int &err) = 0;
+ virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0;
+ virtual int Socketpair(int domain, int type, int protocol,
+ int* fds, int &err) = 0;
+#ifdef WIN32
+ virtual int Closesocket(SOCKET s, int& err) = 0;
+ virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp,
+ int& err) = 0;
+#endif
+};
+
+#define PerlSock_htonl(x) piSock->Htonl(x)
+#define PerlSock_htons(x) piSock->Htons(x)
+#define PerlSock_ntohl(x) piSock->Ntohl(x)
+#define PerlSock_ntohs(x) piSock->Ntohs(x)
+#define PerlSock_accept(s, a, l) piSock->Accept(s, a, l, ErrorNo())
+#define PerlSock_bind(s, n, l) piSock->Bind(s, n, l, ErrorNo())
+#define PerlSock_connect(s, n, l) piSock->Connect(s, n, l, ErrorNo())
+#define PerlSock_endhostent() piSock->Endhostent(ErrorNo())
+#define PerlSock_endnetent() piSock->Endnetent(ErrorNo())
+#define PerlSock_endprotoent() piSock->Endprotoent(ErrorNo())
+#define PerlSock_endservent() piSock->Endservent(ErrorNo())
+#define PerlSock_gethostbyaddr(a, l, t) piSock->Gethostbyaddr(a, l, t, ErrorNo())
+#define PerlSock_gethostbyname(n) piSock->Gethostbyname(n, ErrorNo())
+#define PerlSock_gethostent() piSock->Gethostent(ErrorNo())
+#define PerlSock_gethostname(n, l) piSock->Gethostname(n, l, ErrorNo())
+#define PerlSock_getnetbyaddr(n, t) piSock->Getnetbyaddr(n, t, ErrorNo())
+#define PerlSock_getnetbyname(c) piSock->Getnetbyname(c, ErrorNo())
+#define PerlSock_getnetent() piSock->Getnetent(ErrorNo())
+#define PerlSock_getpeername(s, n, l) piSock->Getpeername(s, n, l, ErrorNo())
+#define PerlSock_getprotobyname(n) piSock->Getprotobyname(n, ErrorNo())
+#define PerlSock_getprotobynumber(n) piSock->Getprotobynumber(n, ErrorNo())
+#define PerlSock_getprotoent() piSock->Getprotoent(ErrorNo())
+#define PerlSock_getservbyname(n, p) piSock->Getservbyname(n, p, ErrorNo())
+#define PerlSock_getservbyport(port, p) piSock->Getservbyport(port, p, ErrorNo())
+#define PerlSock_getservent() piSock->Getservent(ErrorNo())
+#define PerlSock_getsockname(s, n, l) piSock->Getsockname(s, n, l, ErrorNo())
+#define PerlSock_getsockopt(s,l,n,v,i) piSock->Getsockopt(s, l, n, v, i, ErrorNo())
+#define PerlSock_inet_addr(c) piSock->InetAddr(c, ErrorNo())
+#define PerlSock_inet_ntoa(i) piSock->InetNtoa(i, ErrorNo())
+#define PerlSock_listen(s, b) piSock->Listen(s, b, ErrorNo())
+#define PerlSock_recv(s, b, l, f) piSock->Recv(s, b, l, f, ErrorNo())
+#define PerlSock_recvfrom(s,b,l,f,from,fromlen) \
+ piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo())
+#define PerlSock_select(n, r, w, e, t) \
+ piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo())
+#define PerlSock_send(s, b, l, f) piSock->Send(s, b, l, f, ErrorNo())
+#define PerlSock_sendto(s, b, l, f, t, tlen) \
+ piSock->Sendto(s, b, l, f, t, tlen, ErrorNo())
+#define PerlSock_sethostent(f) piSock->Sethostent(f, ErrorNo())
+#define PerlSock_setnetent(f) piSock->Setnetent(f, ErrorNo())
+#define PerlSock_setprotoent(f) piSock->Setprotoent(f, ErrorNo())
+#define PerlSock_setservent(f) piSock->Setservent(f, ErrorNo())
+#define PerlSock_setsockopt(s, l, n, v, len) \
+ piSock->Setsockopt(s, l, n, v, len, ErrorNo())
+#define PerlSock_shutdown(s, h) piSock->Shutdown(s, h, ErrorNo())
+#define PerlSock_socket(a, t, p) piSock->Socket(a, t, p, ErrorNo())
+#define PerlSock_socketpair(a, t, p, f) piSock->Socketpair(a, t, p, f, ErrorNo())
+
+#else /* PERL_OBJECT */
+
+#define PerlSock_htonl(x) htonl(x)
+#define PerlSock_htons(x) htons(x)
+#define PerlSock_ntohl(x) ntohl(x)
+#define PerlSock_ntohs(x) ntohs(x)
+#define PerlSock_accept(s, a, l) accept(s, a, l)
+#define PerlSock_bind(s, n, l) bind(s, n, l)
+#define PerlSock_connect(s, n, l) connect(s, n, l)
+
+#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t)
+#define PerlSock_gethostbyname(n) gethostbyname(n)
+#define PerlSock_gethostent gethostent
+#define PerlSock_endhostent endhostent
+#define PerlSock_gethostname(n, l) gethostname(n, l)
+
+#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t)
+#define PerlSock_getnetbyname(n) getnetbyname(n)
+#define PerlSock_getnetent getnetent
+#define PerlSock_endnetent endnetent
+#define PerlSock_getpeername(s, n, l) getpeername(s, n, l)
+
+#define PerlSock_getprotobyname(n) getprotobyname(n)
+#define PerlSock_getprotobynumber(n) getprotobynumber(n)
+#define PerlSock_getprotoent getprotoent
+#define PerlSock_endprotoent endprotoent
+
+#define PerlSock_getservbyname(n, p) getservbyname(n, p)
+#define PerlSock_getservbyport(port, p) getservbyport(port, p)
+#define PerlSock_getservent getservent
+#define PerlSock_endservent endservent
+
+#define PerlSock_getsockname(s, n, l) getsockname(s, n, l)
+#define PerlSock_getsockopt(s,l,n,v,i) getsockopt(s, l, n, v, i)
+#define PerlSock_inet_addr(c) inet_addr(c)
+#define PerlSock_inet_ntoa(i) inet_ntoa(i)
+#define PerlSock_listen(s, b) listen(s, b)
+#define PerlSock_recvfrom(s, b, l, f, from, fromlen) \
+ recvfrom(s, b, l, f, from, fromlen)
+#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t)
+#define PerlSock_send(s, b, l, f) send(s, b, l, f)
+#define PerlSock_sendto(s, b, l, f, t, tlen) \
+ sendto(s, b, l, f, t, tlen)
+#define PerlSock_sethostent(f) sethostent(f)
+#define PerlSock_setnetent(f) setnetent(f)
+#define PerlSock_setprotoent(f) setprotoent(f)
+#define PerlSock_setservent(f) setservent(f)
+#define PerlSock_setsockopt(s, l, n, v, len) \
+ setsockopt(s, l, n, v, len)
+#define PerlSock_shutdown(s, h) shutdown(s, h)
+#define PerlSock_socket(a, t, p) socket(a, t, p)
+#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f)
+
+
+#endif /* PERL_OBJECT */
+
+#endif /* __Inc__IPerl___ */
+
+++ /dev/null
-/*
-
- iplio.h
- Interface for perl Low IO functions
-
-*/
-
-#ifndef __Inc__IPerlLIO___
-#define __Inc__IPerlLIO___
-
-class IPerlLIO
-{
-public:
- virtual int Access(const char *path, int mode, int &err) = 0;
- virtual int Chmod(const char *filename, int pmode, int &err) = 0;
- virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err) = 0;
- virtual int Chsize(int handle, long size, int &err) = 0;
- virtual int Close(int handle, int &err) = 0;
- virtual int Dup(int handle, int &err) = 0;
- virtual int Dup2(int handle1, int handle2, int &err) = 0;
- virtual int Flock(int fd, int oper, int &err) = 0;
- virtual int FileStat(int handle, struct stat *buffer, int &err) = 0;
- virtual int IOCtl(int i, unsigned int u, char *data, int &err) = 0;
- virtual int Isatty(int handle, int &err) = 0;
- virtual long Lseek(int handle, long offset, int origin, int &err) = 0;
- virtual int Lstat(const char *path, struct stat *buffer, int &err) = 0;
- virtual char *Mktemp(char *Template, int &err) = 0;
- virtual int Open(const char *filename, int oflag, int &err) = 0;
- virtual int Open(const char *filename, int oflag, int pmode, int &err) = 0;
- virtual int Read(int handle, void *buffer, unsigned int count, int &err) = 0;
- virtual int Rename(const char *oldname, const char *newname, int &err) = 0;
- virtual int Setmode(int handle, int mode, int &err) = 0;
- virtual int NameStat(const char *path, struct stat *buffer, int &err) = 0;
- virtual char *Tmpnam(char *string, int &err) = 0;
- virtual int Umask(int pmode, int &err) = 0;
- virtual int Unlink(const char *filename, int &err) = 0;
- virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0;
- virtual int Write(int handle, const void *buffer, unsigned int count, int &err) = 0;
-};
-
-#endif /* __Inc__IPerlLIO___ */
+++ /dev/null
-/*
-
- ipmem.h
- Interface for perl memory allocation
-
-*/
-
-#ifndef __Inc__IPerlMem___
-#define __Inc__IPerlMem___
-
-class IPerlMem
-{
-public:
- virtual void* Malloc(size_t) = 0;
- virtual void* Realloc(void*, size_t) = 0;
- virtual void Free(void*) = 0;
-};
-
-#endif /* __Inc__IPerlMem___ */
-
+++ /dev/null
-/*
-
- ipproc.h
- Interface for perl process functions
-
-*/
-
-#ifndef __Inc__IPerlProc___
-#define __Inc__IPerlProc___
-
-#ifndef Sighandler_t
-typedef Signal_t (*Sighandler_t) _((int));
-#endif
-#ifndef jmp_buf
-#include <setjmp.h>
-#endif
-
-class IPerlProc
-{
-public:
- virtual void Abort(void) = 0;
- virtual void Exit(int status) = 0;
- virtual void _Exit(int status) = 0;
- virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) = 0;
- virtual int Execv(const char *cmdname, const char *const *argv) = 0;
- virtual int Execvp(const char *cmdname, const char *const *argv) = 0;
- virtual uid_t Getuid(void) = 0;
- virtual uid_t Geteuid(void) = 0;
- virtual gid_t Getgid(void) = 0;
- virtual gid_t Getegid(void) = 0;
- virtual char *Getlogin(void) = 0;
- virtual int Kill(int pid, int sig) = 0;
- virtual int Killpg(int pid, int sig) = 0;
- virtual int PauseProc(void) = 0;
- virtual PerlIO* Popen(const char *command, const char *mode) = 0;
- virtual int Pclose(PerlIO *stream) = 0;
- virtual int Pipe(int *phandles) = 0;
- virtual int Setuid(uid_t uid) = 0;
- virtual int Setgid(gid_t gid) = 0;
- virtual int Sleep(unsigned int) = 0;
- virtual int Times(struct tms *timebuf) = 0;
- virtual int Wait(int *status) = 0;
- virtual int Waitpid(int pid, int *status, int flags) = 0;
- virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0;
-#ifdef WIN32
- virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0;
- virtual void FreeBuf(char* msg) = 0;
- virtual BOOL DoCmd(char *cmd) = 0;
- virtual int Spawn(char*cmds) = 0;
- virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) = 0;
- virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0;
-#endif
-};
-
-#endif /* __Inc__IPerlProc___ */
-
+++ /dev/null
-/*
-
- ipsock.h
- Interface for perl socket functions
-
-*/
-
-#ifndef __Inc__IPerlSock___
-#define __Inc__IPerlSock___
-
-class IPerlSock
-{
-public:
- virtual u_long Htonl(u_long hostlong) = 0;
- virtual u_short Htons(u_short hostshort) = 0;
- virtual u_long Ntohl(u_long netlong) = 0;
- virtual u_short Ntohs(u_short netshort) = 0;
- virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) = 0;
- virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0;
- virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0;
- virtual void Endhostent(int &err) = 0;
- virtual void Endnetent(int &err) = 0;
- virtual void Endprotoent(int &err) = 0;
- virtual void Endservent(int &err) = 0;
- virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) = 0;
- virtual struct hostent* Gethostbyname(const char* name, int &err) = 0;
- virtual struct hostent* Gethostent(int &err) = 0;
- virtual int Gethostname(char* name, int namelen, int &err) = 0;
- virtual struct netent *Getnetbyaddr(long net, int type, int &err) = 0;
- virtual struct netent *Getnetbyname(const char *, int &err) = 0;
- virtual struct netent *Getnetent(int &err) = 0;
- virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0;
- virtual struct protoent* Getprotobyname(const char* name, int &err) = 0;
- virtual struct protoent* Getprotobynumber(int number, int &err) = 0;
- virtual struct protoent* Getprotoent(int &err) = 0;
- virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) = 0;
- virtual struct servent* Getservbyport(int port, const char* proto, int &err) = 0;
- virtual struct servent* Getservent(int &err) = 0;
- virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0;
- virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) = 0;
- virtual unsigned long InetAddr(const char* cp, int &err) = 0;
- virtual char* InetNtoa(struct in_addr in, int &err) = 0;
- virtual int Listen(SOCKET s, int backlog, int &err) = 0;
- virtual int Recv(SOCKET s, char* buf, int len, int flags, int &err) = 0;
- virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, struct sockaddr* from, int* fromlen, int &err) = 0;
- virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) = 0;
- virtual int Send(SOCKET s, const char* buf, int len, int flags, int &err) = 0;
- virtual int Sendto(SOCKET s, const char* buf, int len, int flags, const struct sockaddr* to, int tolen, int &err) = 0;
- virtual void Sethostent(int stayopen, int &err) = 0;
- virtual void Setnetent(int stayopen, int &err) = 0;
- virtual void Setprotoent(int stayopen, int &err) = 0;
- virtual void Setservent(int stayopen, int &err) = 0;
- virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) = 0;
- virtual int Shutdown(SOCKET s, int how, int &err) = 0;
- virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0;
- virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) = 0;
-#ifdef WIN32
- virtual int Closesocket(SOCKET s, int& err) = 0;
- virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err) = 0;
-#endif
-};
-
-#endif /* __Inc__IPerlSock___ */
-
+++ /dev/null
-/*
-
- ipstdio.h
- Interface for perl stdio functions
-
-*/
-
-#ifndef __Inc__IPerlStdIO___
-#define __Inc__IPerlStdIO___
-
-#ifndef PerlIO
-typedef struct _PerlIO PerlIO;
-#endif
-
-class IPerlStdIO
-{
-public:
- virtual PerlIO* Stdin(void) = 0;
- virtual PerlIO* Stdout(void) = 0;
- virtual PerlIO* Stderr(void) = 0;
- virtual PerlIO* Open(const char *, const char *, int &err) = 0;
- virtual int Close(PerlIO*, int &err) = 0;
- virtual int Eof(PerlIO*, int &err) = 0;
- virtual int Error(PerlIO*, int &err) = 0;
- virtual void Clearerr(PerlIO*, int &err) = 0;
- virtual int Getc(PerlIO*, int &err) = 0;
- virtual char* GetBase(PerlIO *, int &err) = 0;
- virtual int GetBufsiz(PerlIO *, int &err) = 0;
- virtual int GetCnt(PerlIO *, int &err) = 0;
- virtual char* GetPtr(PerlIO *, int &err) = 0;
- virtual char* Gets(PerlIO*, char*, int, int& err) = 0;
- virtual int Putc(PerlIO*, int, int &err) = 0;
- virtual int Puts(PerlIO*, const char *, int &err) = 0;
- virtual int Flush(PerlIO*, int &err) = 0;
- virtual int Ungetc(PerlIO*,int, int &err) = 0;
- virtual int Fileno(PerlIO*, int &err) = 0;
- virtual PerlIO* Fdopen(int, const char *, int &err) = 0;
- virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err) = 0;
- virtual SSize_t Read(PerlIO*,void *,Size_t, int &err) = 0;
- virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err) = 0;
- virtual void SetBuf(PerlIO *, char*, int &err) = 0;
- virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err) = 0;
- virtual void SetCnt(PerlIO *, int, int &err) = 0;
- virtual void SetPtrCnt(PerlIO *, char *, int, int& err) = 0;
- virtual void Setlinebuf(PerlIO*, int &err) = 0;
- virtual int Printf(PerlIO*, int &err, const char *,...) = 0;
- virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0;
- virtual long Tell(PerlIO*, int &err) = 0;
- virtual int Seek(PerlIO*, off_t, int, int &err) = 0;
- virtual void Rewind(PerlIO*, int &err) = 0;
- virtual PerlIO* Tmpfile(int &err) = 0;
- virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0;
- virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0;
- virtual void Init(int &err) = 0;
- virtual void InitOSExtras(void* p) = 0;
-#ifdef WIN32
- virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
- virtual int GetOSfhandle(int filenum) = 0;
-#endif
-};
-
-#endif /* __Inc__IPerlStdIO___ */
-
*
*/
+#ifdef STRUCT_MGVTBL_DEFINITION
+STRUCT_MGVTBL_DEFINITION;
+#else
struct mgvtbl {
int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg));
int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg));
int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg));
int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg));
};
+#endif
struct magic {
MAGIC* mg_moremagic;
#define OPCODE U16
#endif
+#ifdef BASEOP_DEFINITION
+#define BASEOP BASEOP_DEFINITION
+#else
#define BASEOP \
OP* op_next; \
OP* op_sibling; \
U16 op_seq; \
U8 op_flags; \
U8 op_private;
+#endif
#define OP_GIMME(op,dfl) \
(((op)->op_flags & OPf_WANT) == OPf_WANT_VOID ? G_VOID : \
PERL HOST
1. The perl host is linked with perlX.lib to get perl_alloc. This
function will return a pointer to CPerlObj (the PERL_OBJECT). It
-takes pointers to the various PerlXXX_YYY interfaces (see ipdir.h for
-information on this).
+takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h
+for more information on this).
2. The perl host calls the same functions as normally would be
called in setting up and running a perl script, except that the
functions are now member functions of the PERL_OBJECT.
# endif
#endif
-#include "perlio.h"
-#include "perlmem.h"
-#include "perllio.h"
-#include "perlsock.h"
-#include "perlproc.h"
-#include "perlenv.h"
-#include "perldir.h"
+#include "iperlsys.h"
#ifdef USE_NEXT_CTYPE
# endif
#endif
+#ifdef UNION_ANY_DEFINITION
+UNION_ANY_DEFINITION;
+#else
union any {
void* any_ptr;
I32 any_i32;
IV any_iv;
long any_long;
void (CPERLscope(*any_dptr)) _((void*));
-#if defined(WIN32) && !defined(PERL_OBJECT)
- /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
- char handle_VC_problem[16];
-#endif
};
+#endif
#ifdef USE_THREADS
#define ARGSproto struct perl_thread *thr
+++ /dev/null
-#ifndef H_PERLDIR
-#define H_PERLDIR 1
-
-#ifdef PERL_OBJECT
-
-#include "ipdir.h"
-
-#define PerlDir_mkdir(name, mode) piDir->Makedir((name), (mode), ErrorNo())
-#define PerlDir_chdir(name) piDir->Chdir((name), ErrorNo())
-#define PerlDir_rmdir(name) piDir->Rmdir((name), ErrorNo())
-#define PerlDir_close(dir) piDir->Close((dir), ErrorNo())
-#define PerlDir_open(name) piDir->Open((name), ErrorNo())
-#define PerlDir_read(dir) piDir->Read((dir), ErrorNo())
-#define PerlDir_rewind(dir) piDir->Rewind((dir), ErrorNo())
-#define PerlDir_seek(dir, loc) piDir->Seek((dir), (loc), ErrorNo())
-#define PerlDir_tell(dir) piDir->Tell((dir), ErrorNo())
-#else
-#define PerlDir_mkdir(name, mode) Mkdir((name), (mode))
-#ifdef VMS
-# define PerlDir_chdir(name) chdir(((name) && *(name)) ? (name) : "SYS$LOGIN")
-#else
-# define PerlDir_chdir(name) chdir((name))
-#endif
-#define PerlDir_rmdir(name) rmdir((name))
-#define PerlDir_close(dir) closedir((dir))
-#define PerlDir_open(name) opendir((name))
-#define PerlDir_read(dir) readdir((dir))
-#define PerlDir_rewind(dir) rewinddir((dir))
-#define PerlDir_seek(dir, loc) seekdir((dir), (loc))
-#define PerlDir_tell(dir) telldir((dir))
-#endif /* PERL_OBJECT */
-
-#endif /* Include guard */
-
+++ /dev/null
-#ifndef H_PERLENV
-#define H_PERLENV 1
-
-#ifdef PERL_OBJECT
-
-#include "ipenv.h"
-
-#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo())
-#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo())
-#ifdef WIN32
-#define PerlEnv_lib_path(str) piENV->LibPath((str))
-#define PerlEnv_sitelib_path(str) piENV->SiteLibPath((str))
-#endif
-#else
-#define PerlEnv_putenv(str) putenv((str))
-#define PerlEnv_getenv(str) getenv((str))
-#endif /* PERL_OBJECT */
-
-#endif /* Include guard */
#endif
/*
* This file provides those parts of PerlIO abstraction
- * which are not #defined in perlio.h.
+ * which are not #defined in iperlsys.h.
* Which these are depends on various Configure #ifdef's
*/
+++ /dev/null
-#ifndef H_PERLIO
-#define H_PERLIO 1
-
-/* Clean up (or at least document) the various possible #defines.
- This section attempts to match the 5.003_03 Configure variables
- onto the 5.003_02 header file values.
- I can't figure out where USE_STDIO was supposed to be set.
- --AD
-*/
-#ifndef USE_PERLIO
-# define PERLIO_IS_STDIO
-#endif
-
-/* Below is the 5.003_02 stuff. */
-#ifdef USE_STDIO
-# ifndef PERLIO_IS_STDIO
-# define PERLIO_IS_STDIO
-# endif
-#else
-extern void PerlIO_init _((void));
-#endif
-
-#ifdef PERL_OBJECT
-
-#include "ipstdio.h"
-
-#define PerlIO_canset_cnt(f) 1
-#define PerlIO_has_base(f) 1
-#define PerlIO_has_cntptr(f) 1
-#define PerlIO_fast_gets(f) 1
-
-#define PerlIO_stdin() piStdIO->Stdin()
-#define PerlIO_stdout() piStdIO->Stdout()
-#define PerlIO_stderr() piStdIO->Stderr()
-#define PerlIO_open(x,y) piStdIO->Open((x),(y), ErrorNo())
-#define PerlIO_close(f) piStdIO->Close((f), ErrorNo())
-#define PerlIO_eof(f) piStdIO->Eof((f), ErrorNo())
-#define PerlIO_error(f) piStdIO->Error((f), ErrorNo())
-#define PerlIO_clearerr(f) piStdIO->Clearerr((f), ErrorNo())
-#define PerlIO_getc(f) piStdIO->Getc((f), ErrorNo())
-#define PerlIO_get_base(f) piStdIO->GetBase((f), ErrorNo())
-#define PerlIO_get_bufsiz(f) piStdIO->GetBufsiz((f), ErrorNo())
-#define PerlIO_get_cnt(f) piStdIO->GetCnt((f), ErrorNo())
-#define PerlIO_get_ptr(f) piStdIO->GetPtr((f), ErrorNo())
-#define PerlIO_putc(f,c) piStdIO->Putc((f),(c), ErrorNo())
-#define PerlIO_puts(f,s) piStdIO->Puts((f),(s), ErrorNo())
-#define PerlIO_flush(f) piStdIO->Flush((f), ErrorNo())
-#define PerlIO_gets(s, n, fp) piStdIO->Gets((fp), s, n, ErrorNo())
-#define PerlIO_ungetc(f,c) piStdIO->Ungetc((f),(c), ErrorNo())
-#define PerlIO_fileno(f) piStdIO->Fileno((f), ErrorNo())
-#define PerlIO_fdopen(f, s) piStdIO->Fdopen((f),(s), ErrorNo())
-#define PerlIO_reopen(p, m, f) piStdIO->Reopen((p), (m), (f), ErrorNo())
-#define PerlIO_read(f,buf,count) (SSize_t)piStdIO->Read((f), (buf), (count), ErrorNo())
-#define PerlIO_write(f,buf,count) piStdIO->Write((f), (buf), (count), ErrorNo())
-#define PerlIO_setbuf(f,b) piStdIO->SetBuf((f), (b), ErrorNo())
-#define PerlIO_setvbuf(f,b,t,s) piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo())
-#define PerlIO_set_cnt(f,c) piStdIO->SetCnt((f), (c), ErrorNo())
-#define PerlIO_set_ptrcnt(f,p,c) piStdIO->SetPtrCnt((f), (p), (c), ErrorNo())
-#define PerlIO_setlinebuf(f) piStdIO->Setlinebuf((f), ErrorNo())
-#define PerlIO_printf fprintf
-#define PerlIO_stdoutf piStdIO->Printf
-#define PerlIO_vprintf(f,fmt,a) piStdIO->Vprintf((f), ErrorNo(), (fmt),a)
-#define PerlIO_tell(f) piStdIO->Tell((f), ErrorNo())
-#define PerlIO_seek(f,o,w) piStdIO->Seek((f),(o),(w), ErrorNo())
-#define PerlIO_getpos(f,p) piStdIO->Getpos((f),(p), ErrorNo())
-#define PerlIO_setpos(f,p) piStdIO->Setpos((f),(p), ErrorNo())
-#define PerlIO_rewind(f) piStdIO->Rewind((f), ErrorNo())
-#define PerlIO_tmpfile() piStdIO->Tmpfile(ErrorNo())
-#define PerlIO_init() piStdIO->Init(ErrorNo())
-#undef init_os_extras
-#define init_os_extras() piStdIO->InitOSExtras(this)
-
-#else
-#include "perlsdio.h"
-#endif
-
-#ifndef PERLIO_IS_STDIO
-#ifdef USE_SFIO
-#include "perlsfio.h"
-#endif /* USE_SFIO */
-#endif /* PERLIO_IS_STDIO */
-
-#ifndef EOF
-#define EOF (-1)
-#endif
-
-/* This is to catch case with no stdio */
-#ifndef BUFSIZ
-#define BUFSIZ 1024
-#endif
-
-#ifndef SEEK_SET
-#define SEEK_SET 0
-#endif
-
-#ifndef SEEK_CUR
-#define SEEK_CUR 1
-#endif
-
-#ifndef SEEK_END
-#define SEEK_END 2
-#endif
-
-#ifndef PerlIO
-struct _PerlIO;
-#define PerlIO struct _PerlIO
-#endif /* No PerlIO */
-
-#ifndef Fpos_t
-#define Fpos_t long
-#endif
-
-#ifndef NEXT30_NO_ATTRIBUTE
-#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */
-#ifdef __attribute__ /* Avoid possible redefinition errors */
-#undef __attribute__
-#endif
-#define __attribute__(attr)
-#endif
-#endif
-
-#ifndef PerlIO_stdoutf
-extern int PerlIO_stdoutf _((const char *,...))
- __attribute__((format (printf, 1, 2)));
-#endif
-#ifndef PerlIO_puts
-extern int PerlIO_puts _((PerlIO *,const char *));
-#endif
-#ifndef PerlIO_open
-extern PerlIO * PerlIO_open _((const char *,const char *));
-#endif
-#ifndef PerlIO_close
-extern int PerlIO_close _((PerlIO *));
-#endif
-#ifndef PerlIO_eof
-extern int PerlIO_eof _((PerlIO *));
-#endif
-#ifndef PerlIO_error
-extern int PerlIO_error _((PerlIO *));
-#endif
-#ifndef PerlIO_clearerr
-extern void PerlIO_clearerr _((PerlIO *));
-#endif
-#ifndef PerlIO_getc
-extern int PerlIO_getc _((PerlIO *));
-#endif
-#ifndef PerlIO_putc
-extern int PerlIO_putc _((PerlIO *,int));
-#endif
-#ifndef PerlIO_flush
-extern int PerlIO_flush _((PerlIO *));
-#endif
-#ifndef PerlIO_ungetc
-extern int PerlIO_ungetc _((PerlIO *,int));
-#endif
-#ifndef PerlIO_fileno
-extern int PerlIO_fileno _((PerlIO *));
-#endif
-#ifndef PerlIO_fdopen
-extern PerlIO * PerlIO_fdopen _((int, const char *));
-#endif
-#ifndef PerlIO_importFILE
-extern PerlIO * PerlIO_importFILE _((FILE *,int));
-#endif
-#ifndef PerlIO_exportFILE
-extern FILE * PerlIO_exportFILE _((PerlIO *,int));
-#endif
-#ifndef PerlIO_findFILE
-extern FILE * PerlIO_findFILE _((PerlIO *));
-#endif
-#ifndef PerlIO_releaseFILE
-extern void PerlIO_releaseFILE _((PerlIO *,FILE *));
-#endif
-#ifndef PerlIO_read
-extern SSize_t PerlIO_read _((PerlIO *,void *,Size_t));
-#endif
-#ifndef PerlIO_write
-extern SSize_t PerlIO_write _((PerlIO *,const void *,Size_t));
-#endif
-#ifndef PerlIO_setlinebuf
-extern void PerlIO_setlinebuf _((PerlIO *));
-#endif
-#ifndef PerlIO_printf
-extern int PerlIO_printf _((PerlIO *, const char *,...))
- __attribute__((format (printf, 2, 3)));
-#endif
-#ifndef PerlIO_sprintf
-extern int PerlIO_sprintf _((char *, int, const char *,...))
- __attribute__((format (printf, 3, 4)));
-#endif
-#ifndef PerlIO_vprintf
-extern int PerlIO_vprintf _((PerlIO *, const char *, va_list));
-#endif
-#ifndef PerlIO_tell
-extern long PerlIO_tell _((PerlIO *));
-#endif
-#ifndef PerlIO_seek
-extern int PerlIO_seek _((PerlIO *,off_t,int));
-#endif
-#ifndef PerlIO_rewind
-extern void PerlIO_rewind _((PerlIO *));
-#endif
-#ifndef PerlIO_has_base
-extern int PerlIO_has_base _((PerlIO *));
-#endif
-#ifndef PerlIO_has_cntptr
-extern int PerlIO_has_cntptr _((PerlIO *));
-#endif
-#ifndef PerlIO_fast_gets
-extern int PerlIO_fast_gets _((PerlIO *));
-#endif
-#ifndef PerlIO_canset_cnt
-extern int PerlIO_canset_cnt _((PerlIO *));
-#endif
-#ifndef PerlIO_get_ptr
-extern STDCHAR * PerlIO_get_ptr _((PerlIO *));
-#endif
-#ifndef PerlIO_get_cnt
-extern int PerlIO_get_cnt _((PerlIO *));
-#endif
-#ifndef PerlIO_set_cnt
-extern void PerlIO_set_cnt _((PerlIO *,int));
-#endif
-#ifndef PerlIO_set_ptrcnt
-extern void PerlIO_set_ptrcnt _((PerlIO *,STDCHAR *,int));
-#endif
-#ifndef PerlIO_get_base
-extern STDCHAR * PerlIO_get_base _((PerlIO *));
-#endif
-#ifndef PerlIO_get_bufsiz
-extern int PerlIO_get_bufsiz _((PerlIO *));
-#endif
-#ifndef PerlIO_tmpfile
-extern PerlIO * PerlIO_tmpfile _((void));
-#endif
-#ifndef PerlIO_stdin
-extern PerlIO * PerlIO_stdin _((void));
-#endif
-#ifndef PerlIO_stdout
-extern PerlIO * PerlIO_stdout _((void));
-#endif
-#ifndef PerlIO_stderr
-extern PerlIO * PerlIO_stderr _((void));
-#endif
-#ifndef PerlIO_getpos
-extern int PerlIO_getpos _((PerlIO *,Fpos_t *));
-#endif
-#ifndef PerlIO_setpos
-extern int PerlIO_setpos _((PerlIO *,const Fpos_t *));
-#endif
-#endif /* Include guard */
+++ /dev/null
-#ifndef H_PERLLIO
-#define H_PERLLIO 1
-
-#ifdef PERL_OBJECT
-
-#include "iplio.h"
-
-#define PerlLIO_access(file, mode) piLIO->Access((file), (mode), ErrorNo())
-#define PerlLIO_chmod(file, mode) piLIO->Chmod((file), (mode), ErrorNo())
-#define PerlLIO_chown(file, owner, group) piLIO->Chown((file), (owner), (group), ErrorNo())
-#define PerlLIO_chsize(fd, size) piLIO->Chsize((fd), (size), ErrorNo())
-#define PerlLIO_close(fd) piLIO->Close((fd), ErrorNo())
-#define PerlLIO_dup(fd) piLIO->Dup((fd), ErrorNo())
-#define PerlLIO_dup2(fd1, fd2) piLIO->Dup2((fd1), (fd2), ErrorNo())
-#define PerlLIO_flock(fd, op) piLIO->Flock((fd), (op), ErrorNo())
-#define PerlLIO_fstat(fd, buf) piLIO->FileStat((fd), (buf), ErrorNo())
-#define PerlLIO_ioctl(fd, u, buf) piLIO->IOCtl((fd), (u), (buf), ErrorNo())
-#define PerlLIO_isatty(fd) piLIO->Isatty((fd), ErrorNo())
-#define PerlLIO_lseek(fd, offset, mode) piLIO->Lseek((fd), (offset), (mode), ErrorNo())
-#define PerlLIO_lstat(name, buf) piLIO->Lstat((name), (buf), ErrorNo())
-#define PerlLIO_mktemp(file) piLIO->Mktemp((file), ErrorNo())
-#define PerlLIO_open(file, flag) piLIO->Open((file), (flag), ErrorNo())
-#define PerlLIO_open3(file, flag, perm) piLIO->Open((file), (flag), (perm), ErrorNo())
-#define PerlLIO_read(fd, buf, count) piLIO->Read((fd), (buf), (count), ErrorNo())
-#define PerlLIO_rename(oldname, newname) piLIO->Rename((oldname), (newname), ErrorNo())
-#define PerlLIO_setmode(fd, mode) piLIO->Setmode((fd), (mode), ErrorNo())
-#define PerlLIO_stat(name, buf) piLIO->NameStat((name), (buf), ErrorNo())
-#define PerlLIO_tmpnam(str) piLIO->Tmpnam((str), ErrorNo())
-#define PerlLIO_umask(mode) piLIO->Umask((mode), ErrorNo())
-#define PerlLIO_unlink(file) piLIO->Unlink((file), ErrorNo())
-#define PerlLIO_utime(file, time) piLIO->Utime((file), (time), ErrorNo())
-#define PerlLIO_write(fd, buf, count) piLIO->Write((fd), (buf), (count), ErrorNo())
-#else
-#define PerlLIO_access(file, mode) access((file), (mode))
-#define PerlLIO_chmod(file, mode) chmod((file), (mode))
-#define PerlLIO_chown(file, owner, group) chown((file), (owner), (group))
-#define PerlLIO_chsize(fd, size) chsize((fd), (size))
-#define PerlLIO_close(fd) close((fd))
-#define PerlLIO_dup(fd) dup((fd))
-#define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2))
-#define PerlLIO_flock(fd, op) FLOCK((fd), (op))
-#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf))
-#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf))
-#define PerlLIO_isatty(fd) isatty((fd))
-#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode))
-#define PerlLIO_lstat(name, buf) lstat((name), (buf))
-#define PerlLIO_mktemp(file) mktemp((file))
-#define PerlLIO_mkstemp(file) mkstemp((file))
-#define PerlLIO_open(file, flag) open((file), (flag))
-#define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm))
-#define PerlLIO_read(fd, buf, count) read((fd), (buf), (count))
-#define PerlLIO_rename(oldname, newname) rename((oldname), (newname))
-#define PerlLIO_setmode(fd, mode) setmode((fd), (mode))
-#define PerlLIO_stat(name, buf) Stat((name), (buf))
-#define PerlLIO_tmpnam(str) tmpnam((str))
-#define PerlLIO_umask(mode) umask((mode))
-#define PerlLIO_unlink(file) unlink((file))
-#define PerlLIO_utime(file, time) utime((file), (time))
-#define PerlLIO_write(fd, buf, count) write((fd), (buf), (count))
-#endif /* PERL_OBJECT */
-
-#endif /* Include guard */
-
+++ /dev/null
-#ifndef H_PERLMEM
-#define H_PERLMEM 1
-
-#ifdef PERL_OBJECT
-
-#include "ipmem.h"
-
-#define PerlMem_malloc(size) piMem->Malloc((size))
-#define PerlMem_realloc(buf, size) piMem->Realloc((buf), (size))
-#define PerlMem_free(buf) piMem->Free((buf))
-#else
-#define PerlMem_malloc(size) malloc((size))
-#define PerlMem_realloc(buf, size) realloc((buf), (size))
-#define PerlMem_free(buf) free((buf))
-
-#endif /* PERL_OBJECT */
-
-#endif /* Include guard */
-
+++ /dev/null
-#ifndef H_PERLPROC
-#define H_PERLPROC 1
-
-#ifdef PERL_OBJECT
-
-#include "ipproc.h"
-
-#define PerlProc_abort() piProc->Abort()
-#define PerlProc_exit(s) piProc->Exit((s))
-#define PerlProc__exit(s) piProc->_Exit((s))
-#define PerlProc_execl(c, w, x, y, z) piProc->Execl((c), (w), (x), (y), (z))
-#define PerlProc_execv(c, a) piProc->Execv((c), (a))
-#define PerlProc_execvp(c, a) piProc->Execvp((c), (a))
-#define PerlProc_getuid() piProc->Getuid()
-#define PerlProc_geteuid() piProc->Geteuid()
-#define PerlProc_getgid() piProc->Getgid()
-#define PerlProc_getegid() piProc->Getegid()
-#define PerlProc_getlogin() piProc->Getlogin()
-#define PerlProc_kill(i, a) piProc->Kill((i), (a))
-#define PerlProc_killpg(i, a) piProc->Killpg((i), (a))
-#define PerlProc_pause() piProc->PauseProc()
-#define PerlProc_popen(c, m) piProc->Popen((c), (m))
-#define PerlProc_pclose(f) piProc->Pclose((f))
-#define PerlProc_pipe(fd) piProc->Pipe((fd))
-#define PerlProc_setuid(u) piProc->Setuid((u))
-#define PerlProc_setgid(g) piProc->Setgid((g))
-#define PerlProc_sleep(t) piProc->Sleep((t))
-#define PerlProc_times(t) piProc->Times((t))
-#define PerlProc_wait(t) piProc->Wait((t))
-#define PerlProc_waitpid(p, s, f) piProc->Waitpid((p), (s), (f))
-#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
-#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
-#define PerlProc_signal(n, h) piProc->Signal((n), (h))
-#ifdef WIN32
-#define PerlProc_GetSysMsg(s,l,e) piProc->GetSysMsg((s), (l), (e))
-#define PerlProc_FreeBuf(s) piProc->FreeBuf((s))
-#define PerlProc_Cmd(s) piProc->DoCmd((s))
-#define do_spawn(s) piProc->Spawn((s))
-#define do_spawnvp(m, c, a) piProc->Spawnvp((m), (c), (a))
-#define PerlProc_aspawn(m, c, a) piProc->ASpawn((m), (c), (a))
-#endif
-#else
-#define PerlProc_abort() abort()
-#define PerlProc_exit(s) exit((s))
-#define PerlProc__exit(s) _exit((s))
-#define PerlProc_execl(c, w, x, y, z) execl((c), (w), (x), (y), (z))
-#define PerlProc_execv(c, a) execv((c), (a))
-#define PerlProc_execvp(c, a) execvp((c), (a))
-#define PerlProc_getuid() getuid()
-#define PerlProc_geteuid() geteuid()
-#define PerlProc_getgid() getgid()
-#define PerlProc_getegid() getegid()
-#define PerlProc_getlogin() getlogin()
-#define PerlProc_kill(i, a) kill((i), (a))
-#define PerlProc_killpg(i, a) killpg((i), (a))
-#define PerlProc_pause() Pause()
-#define PerlProc_popen(c, m) my_popen((c), (m))
-#define PerlProc_pclose(f) my_pclose((f))
-#define PerlProc_pipe(fd) pipe((fd))
-#define PerlProc_setuid(u) setuid((u))
-#define PerlProc_setgid(g) setgid((g))
-#define PerlProc_sleep(t) sleep((t))
-#define PerlProc_times(t) times((t))
-#define PerlProc_wait(t) wait((t))
-#define PerlProc_waitpid(p, s, f) waitpid((p), (s), (f))
-#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
-#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
-#define PerlProc_signal(n, h) signal((n), (h))
-#endif /* PERL_OBJECT */
-
-#endif /* Include guard */
+++ /dev/null
-#ifndef H_PERLSOCK
-#define H_PERLSOCK 1
-
-#ifdef PERL_OBJECT
-
-#include "ipsock.h"
-
-#define PerlSock_htonl(x) piSock->Htonl(x)
-#define PerlSock_htons(x) piSock->Htons(x)
-#define PerlSock_ntohl(x) piSock->Ntohl(x)
-#define PerlSock_ntohs(x) piSock->Ntohs(x)
-#define PerlSock_accept(s, a, l) piSock->Accept(s, a, l, ErrorNo())
-#define PerlSock_bind(s, n, l) piSock->Bind(s, n, l, ErrorNo())
-#define PerlSock_connect(s, n, l) piSock->Connect(s, n, l, ErrorNo())
-#define PerlSock_endhostent() piSock->Endhostent(ErrorNo())
-#define PerlSock_endnetent() piSock->Endnetent(ErrorNo())
-#define PerlSock_endprotoent() piSock->Endprotoent(ErrorNo())
-#define PerlSock_endservent() piSock->Endservent(ErrorNo())
-#define PerlSock_gethostbyaddr(a, l, t) piSock->Gethostbyaddr(a, l, t, ErrorNo())
-#define PerlSock_gethostbyname(n) piSock->Gethostbyname(n, ErrorNo())
-#define PerlSock_gethostent() piSock->Gethostent(ErrorNo())
-#define PerlSock_gethostname(n, l) piSock->Gethostname(n, l, ErrorNo())
-#define PerlSock_getnetbyaddr(n, t) piSock->Getnetbyaddr(n, t, ErrorNo())
-#define PerlSock_getnetbyname(c) piSock->Getnetbyname(c, ErrorNo())
-#define PerlSock_getnetent() piSock->Getnetent(ErrorNo())
-#define PerlSock_getpeername(s, n, l) piSock->Getpeername(s, n, l, ErrorNo())
-#define PerlSock_getprotobyname(n) piSock->Getprotobyname(n, ErrorNo())
-#define PerlSock_getprotobynumber(n) piSock->Getprotobynumber(n, ErrorNo())
-#define PerlSock_getprotoent() piSock->Getprotoent(ErrorNo())
-#define PerlSock_getservbyname(n, p) piSock->Getservbyname(n, p, ErrorNo())
-#define PerlSock_getservbyport(port, p) piSock->Getservbyport(port, p, ErrorNo())
-#define PerlSock_getservent() piSock->Getservent(ErrorNo())
-#define PerlSock_getsockname(s, n, l) piSock->Getsockname(s, n, l, ErrorNo())
-#define PerlSock_getsockopt(s, l, n, v, i) piSock->Getsockopt(s, l, n, v, i, ErrorNo())
-#define PerlSock_inet_addr(c) piSock->InetAddr(c, ErrorNo())
-#define PerlSock_inet_ntoa(i) piSock->InetNtoa(i, ErrorNo())
-#define PerlSock_listen(s, b) piSock->Listen(s, b, ErrorNo())
-#define PerlSock_recv(s, b, l, f) piSock->Recv(s, b, l, f, ErrorNo())
-#define PerlSock_recvfrom(s, b, l, f, from, fromlen) piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo())
-#define PerlSock_select(n, r, w, e, t) piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo())
-#define PerlSock_send(s, b, l, f) piSock->Send(s, b, l, f, ErrorNo())
-#define PerlSock_sendto(s, b, l, f, t, tlen) piSock->Sendto(s, b, l, f, t, tlen, ErrorNo())
-#define PerlSock_sethostent(f) piSock->Sethostent(f, ErrorNo())
-#define PerlSock_setnetent(f) piSock->Setnetent(f, ErrorNo())
-#define PerlSock_setprotoent(f) piSock->Setprotoent(f, ErrorNo())
-#define PerlSock_setservent(f) piSock->Setservent(f, ErrorNo())
-#define PerlSock_setsockopt(s, l, n, v, len) piSock->Setsockopt(s, l, n, v, len, ErrorNo())
-#define PerlSock_shutdown(s, h) piSock->Shutdown(s, h, ErrorNo())
-#define PerlSock_socket(a, t, p) piSock->Socket(a, t, p, ErrorNo())
-#define PerlSock_socketpair(a, t, p, f) piSock->Socketpair(a, t, p, f, ErrorNo())
-#else
-#define PerlSock_htonl(x) htonl(x)
-#define PerlSock_htons(x) htons(x)
-#define PerlSock_ntohl(x) ntohl(x)
-#define PerlSock_ntohs(x) ntohs(x)
-#define PerlSock_accept(s, a, l) accept(s, a, l)
-#define PerlSock_bind(s, n, l) bind(s, n, l)
-#define PerlSock_connect(s, n, l) connect(s, n, l)
-
-#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t)
-#define PerlSock_gethostbyname(n) gethostbyname(n)
-#define PerlSock_gethostent gethostent
-#define PerlSock_endhostent endhostent
-#define PerlSock_gethostname(n, l) gethostname(n, l)
-
-#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t)
-#define PerlSock_getnetbyname(n) getnetbyname(n)
-#define PerlSock_getnetent getnetent
-#define PerlSock_endnetent endnetent
-#define PerlSock_getpeername(s, n, l) getpeername(s, n, l)
-
-#define PerlSock_getprotobyname(n) getprotobyname(n)
-#define PerlSock_getprotobynumber(n) getprotobynumber(n)
-#define PerlSock_getprotoent getprotoent
-#define PerlSock_endprotoent endprotoent
-
-#define PerlSock_getservbyname(n, p) getservbyname(n, p)
-#define PerlSock_getservbyport(port, p) getservbyport(port, p)
-#define PerlSock_getservent getservent
-#define PerlSock_endservent endservent
-
-#define PerlSock_getsockname(s, n, l) getsockname(s, n, l)
-#define PerlSock_getsockopt(s, l, n, v, i) getsockopt(s, l, n, v, i)
-#define PerlSock_inet_addr(c) inet_addr(c)
-#define PerlSock_inet_ntoa(i) inet_ntoa(i)
-#define PerlSock_listen(s, b) listen(s, b)
-#define PerlSock_recvfrom(s, b, l, f, from, fromlen) recvfrom(s, b, l, f, from, fromlen)
-#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t)
-#define PerlSock_send(s, b, l, f) send(s, b, l, f)
-#define PerlSock_sendto(s, b, l, f, t, tlen) sendto(s, b, l, f, t, tlen)
-#define PerlSock_sethostent(f) sethostent(f)
-#define PerlSock_setnetent(f) setnetent(f)
-#define PerlSock_setprotoent(f) setprotoent(f)
-#define PerlSock_setservent(f) setservent(f)
-#define PerlSock_setsockopt(s, l, n, v, len) setsockopt(s, l, n, v, len)
-#define PerlSock_shutdown(s, h) shutdown(s, h)
-#define PerlSock_socket(a, t, p) socket(a, t, p)
-#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f)
-#endif /* PERL_OBJECT */
-
-#endif /* Include guard */
-
#ifdef PERL_OBJECT
-#include "ipstdio.h"
-#include "ipdir.h"
-#include "ipenv.h"
-#include "iplio.h"
-#include "ipmem.h"
-#include "ipproc.h"
-#include "ipsock.h"
#define VIRTUAL virtual
#else
#define VIRTUAL
#include "EXTERN.h"
#include "perl.h"
-#include "perlmem.h"
#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
..\gv.h \
..\handy.h \
..\hv.h \
+ ..\iperlsys.h \
..\mg.h \
..\nostdio.h \
..\op.h \
..\opcode.h \
..\perl.h \
- ..\perlio.h \
..\perlsdio.h \
..\perlsfio.h \
..\perly.h \
static SV *error_sv;
static char *
-OS_Error_String(void)
+OS_Error_String(CPERLarg)
{
DWORD err = GetLastError();
STRLEN len;
DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError(PERL_OBJECT_THIS_ "load_file:%s",OS_Error_String()) ;
+ SaveError(PERL_OBJECT_THIS_ "load_file:%s",
+ OS_Error_String(PERL_OBJECT_THIS)) ;
else
sv_setiv( ST(0), (IV)RETVAL);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError(PERL_OBJECT_THIS_ "find_symbol:%s",OS_Error_String()) ;
+ SaveError(PERL_OBJECT_THIS_ "find_symbol:%s",
+ OS_Error_String(PERL_OBJECT_THIS)) ;
else
sv_setiv( ST(0), (IV)RETVAL);
..\gv.h \
..\handy.h \
..\hv.h \
+ ..\iperlsys.h \
..\mg.h \
..\nostdio.h \
..\op.h \
..\opcode.h \
..\perl.h \
- ..\perlio.h \
..\perlsdio.h \
..\perlsfio.h \
..\perly.h \
--- /dev/null
+
+#include "iperlsys.h"
+
+extern CPerlObj *pPerl;
+
+#define CALLFUNC0RET(x)\
+ int ret = x;\
+ if (ret < 0)\
+ err = errno;\
+ return ret;
+
+#define PROCESS_AND_RETURN \
+ if (errno) \
+ err = errno; \
+ return r
+
+#define CALLFUNCRET(x)\
+ int ret = x;\
+ if (ret)\
+ err = errno;\
+ return ret;
+
+#define CALLFUNCERR(x)\
+ int ret = x;\
+ if (errno)\
+ err = errno;\
+ return ret;
+
+#define LCALLFUNCERR(x)\
+ long ret = x;\
+ if (errno)\
+ err = errno;\
+ return ret;
+
+extern int g_closedir(DIR *dirp);
+extern DIR * g_opendir(char *filename);
+extern struct direct * g_readdir(DIR *dirp);
+extern void g_rewinddir(DIR *dirp);
+extern void g_seekdir(DIR *dirp, long loc);
+extern long g_telldir(DIR *dirp);
+
+class CPerlDir : public IPerlDir
+{
+public:
+ CPerlDir() {};
+ virtual int Makedir(const char *dirname, int mode, int &err)
+ {
+ CALLFUNC0RET(win32_mkdir(dirname, mode));
+ };
+ virtual int Chdir(const char *dirname, int &err)
+ {
+ CALLFUNC0RET(win32_chdir(dirname));
+ };
+ virtual int Rmdir(const char *dirname, int &err)
+ {
+ CALLFUNC0RET(win32_rmdir(dirname));
+ };
+ virtual int Close(DIR *dirp, int &err)
+ {
+ return g_closedir(dirp);
+ };
+ virtual DIR *Open(char *filename, int &err)
+ {
+ return g_opendir(filename);
+ };
+ virtual struct direct *Read(DIR *dirp, int &err)
+ {
+ return g_readdir(dirp);
+ };
+ virtual void Rewind(DIR *dirp, int &err)
+ {
+ g_rewinddir(dirp);
+ };
+ virtual void Seek(DIR *dirp, long loc, int &err)
+ {
+ g_seekdir(dirp, loc);
+ };
+ virtual long Tell(DIR *dirp, int &err)
+ {
+ return g_telldir(dirp);
+ };
+};
+
+
+extern char * g_win32_get_privlib(char *pl);
+extern char * g_win32_get_sitelib(char *pl);
+
+class CPerlEnv : public IPerlEnv
+{
+public:
+ CPerlEnv() {};
+ virtual char *Getenv(const char *varname, int &err)
+ {
+ return win32_getenv(varname);
+ };
+ virtual int Putenv(const char *envstring, int &err)
+ {
+ return putenv(envstring);
+ };
+ virtual char* LibPath(char *pl)
+ {
+ return g_win32_get_privlib(pl);
+ };
+ virtual char* SiteLibPath(char *pl)
+ {
+ return g_win32_get_sitelib(pl);
+ };
+};
+
+class CPerlSock : public IPerlSock
+{
+public:
+ CPerlSock() {};
+ virtual u_long Htonl(u_long hostlong)
+ {
+ return win32_htonl(hostlong);
+ };
+ virtual u_short Htons(u_short hostshort)
+ {
+ return win32_htons(hostshort);
+ };
+ virtual u_long Ntohl(u_long netlong)
+ {
+ return win32_ntohl(netlong);
+ };
+ virtual u_short Ntohs(u_short netshort)
+ {
+ return win32_ntohs(netshort);
+ }
+
+ virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
+ {
+ SOCKET r = win32_accept(s, addr, addrlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err)
+ {
+ int r = win32_bind(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err)
+ {
+ int r = win32_connect(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual void Endhostent(int &err)
+ {
+ win32_endhostent();
+ };
+ virtual void Endnetent(int &err)
+ {
+ win32_endnetent();
+ };
+ virtual void Endprotoent(int &err)
+ {
+ win32_endprotoent();
+ };
+ virtual void Endservent(int &err)
+ {
+ win32_endservent();
+ };
+ virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err)
+ {
+ struct hostent *r = win32_gethostbyaddr(addr, len, type);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct hostent* Gethostbyname(const char* name, int &err)
+ {
+ struct hostent *r = win32_gethostbyname(name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct hostent* Gethostent(int &err)
+ {
+ croak("gethostent not implemented!\n");
+ return NULL;
+ };
+ virtual int Gethostname(char* name, int namelen, int &err)
+ {
+ int r = win32_gethostname(name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetbyaddr(long net, int type, int &err)
+ {
+ struct netent *r = win32_getnetbyaddr(net, type);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetbyname(const char *name, int &err)
+ {
+ struct netent *r = win32_getnetbyname((char*)name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetent(int &err)
+ {
+ struct netent *r = win32_getnetent();
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err)
+ {
+ int r = win32_getpeername(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotobyname(const char* name, int &err)
+ {
+ struct protoent *r = win32_getprotobyname(name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotobynumber(int number, int &err)
+ {
+ struct protoent *r = win32_getprotobynumber(number);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotoent(int &err)
+ {
+ struct protoent *r = win32_getprotoent();
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservbyname(const char* name, const char* proto, int &err)
+ {
+ struct servent *r = win32_getservbyname(name, proto);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservbyport(int port, const char* proto, int &err)
+ {
+ struct servent *r = win32_getservbyport(port, proto);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservent(int &err)
+ {
+ struct servent *r = win32_getservent();
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err)
+ {
+ int r = win32_getsockname(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
+ {
+ int r = win32_getsockopt(s, level, optname, optval, optlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual unsigned long InetAddr(const char* cp, int &err)
+ {
+ unsigned long r = win32_inet_addr(cp);
+ PROCESS_AND_RETURN;
+ };
+ virtual char* InetNtoa(struct in_addr in, int &err)
+ {
+ char *r = win32_inet_ntoa(in);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Listen(SOCKET s, int backlog, int &err)
+ {
+ int r = win32_listen(s, backlog);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err)
+ {
+ int r = win32_recv(s, buffer, len, flags);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
+ {
+ int r = win32_recvfrom(s, buffer, len, flags, from, fromlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err)
+ {
+ int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err)
+ {
+ int r = win32_send(s, buffer, len, flags);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
+ {
+ int r = win32_sendto(s, buffer, len, flags, to, tolen);
+ PROCESS_AND_RETURN;
+ };
+ virtual void Sethostent(int stayopen, int &err)
+ {
+ win32_sethostent(stayopen);
+ };
+ virtual void Setnetent(int stayopen, int &err)
+ {
+ win32_setnetent(stayopen);
+ };
+ virtual void Setprotoent(int stayopen, int &err)
+ {
+ win32_setprotoent(stayopen);
+ };
+ virtual void Setservent(int stayopen, int &err)
+ {
+ win32_setservent(stayopen);
+ };
+ virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
+ {
+ int r = win32_setsockopt(s, level, optname, optval, optlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Shutdown(SOCKET s, int how, int &err)
+ {
+ int r = win32_shutdown(s, how);
+ PROCESS_AND_RETURN;
+ };
+ virtual SOCKET Socket(int af, int type, int protocol, int &err)
+ {
+ SOCKET r = win32_socket(af, type, protocol);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err)
+ {
+ croak("socketpair not implemented!\n");
+ return 0;
+ };
+ virtual int Closesocket(SOCKET s, int& err)
+ {
+ int r = win32_closesocket(s);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err)
+ {
+ int r = win32_ioctlsocket(s, cmd, argp);
+ PROCESS_AND_RETURN;
+ };
+};
+
+class CPerlLIO : public IPerlLIO
+{
+public:
+ CPerlLIO() {};
+ virtual int Access(const char *path, int mode, int &err)
+ {
+ CALLFUNCRET(access(path, mode))
+ };
+ virtual int Chmod(const char *filename, int pmode, int &err)
+ {
+ CALLFUNCRET(chmod(filename, pmode))
+ };
+ virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err)
+ {
+ CALLFUNCERR(chown(filename, owner, group))
+ };
+ virtual int Chsize(int handle, long size, int &err)
+ {
+ CALLFUNCRET(chsize(handle, size))
+ };
+ virtual int Close(int handle, int &err)
+ {
+ CALLFUNCRET(win32_close(handle))
+ };
+ virtual int Dup(int handle, int &err)
+ {
+ CALLFUNCERR(win32_dup(handle))
+ };
+ virtual int Dup2(int handle1, int handle2, int &err)
+ {
+ CALLFUNCERR(win32_dup2(handle1, handle2))
+ };
+ virtual int Flock(int fd, int oper, int &err)
+ {
+ CALLFUNCERR(win32_flock(fd, oper))
+ };
+ virtual int FileStat(int handle, struct stat *buffer, int &err)
+ {
+ CALLFUNCERR(fstat(handle, buffer))
+ };
+ virtual int IOCtl(int i, unsigned int u, char *data, int &err)
+ {
+ CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
+ };
+ virtual int Isatty(int fd, int &err)
+ {
+ return isatty(fd);
+ };
+ virtual long Lseek(int handle, long offset, int origin, int &err)
+ {
+ LCALLFUNCERR(win32_lseek(handle, offset, origin))
+ };
+ virtual int Lstat(const char *path, struct stat *buffer, int &err)
+ {
+ return NameStat(path, buffer, err);
+ };
+ virtual char *Mktemp(char *Template, int &err)
+ {
+ return mktemp(Template);
+ };
+ virtual int Open(const char *filename, int oflag, int &err)
+ {
+ CALLFUNCERR(win32_open(filename, oflag))
+ };
+ virtual int Open(const char *filename, int oflag, int pmode, int &err)
+ {
+ int ret;
+ if(stricmp(filename, "/dev/null") == 0)
+ ret = open("NUL", oflag, pmode);
+ else
+ ret = open(filename, oflag, pmode);
+
+ if(errno)
+ err = errno;
+ return ret;
+ };
+ virtual int Read(int handle, void *buffer, unsigned int count, int &err)
+ {
+ CALLFUNCERR(win32_read(handle, buffer, count))
+ };
+ virtual int Rename(const char *OldFileName, const char *newname, int &err)
+ {
+ char szNewWorkName[MAX_PATH+1];
+ WIN32_FIND_DATA fdOldFile, fdNewFile;
+ HANDLE handle;
+ char *ptr;
+
+ if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
+ && strchr(newname, '\\') == NULL
+ && strchr(newname, '/') == NULL)
+ {
+ strcpy(szNewWorkName, OldFileName);
+ if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
+ ptr = strrchr(szNewWorkName, '/');
+ strcpy(++ptr, newname);
+ }
+ else
+ strcpy(szNewWorkName, newname);
+
+ if(stricmp(OldFileName, szNewWorkName) != 0)
+ { // check that we're not being fooled by relative paths
+ // and only delete the new file
+ // 1) if it exists
+ // 2) it is not the same file as the old file
+ // 3) old file exist
+ // GetFullPathName does not return the long file name on some systems
+ handle = FindFirstFile(OldFileName, &fdOldFile);
+ if(handle != INVALID_HANDLE_VALUE)
+ {
+ FindClose(handle);
+
+ handle = FindFirstFile(szNewWorkName, &fdNewFile);
+
+ if(handle != INVALID_HANDLE_VALUE)
+ FindClose(handle);
+ else
+ fdNewFile.cFileName[0] = '\0';
+
+ if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
+ && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
+ { // file exists and not same file
+ DeleteFile(szNewWorkName);
+ }
+ }
+ }
+ int ret = rename(OldFileName, szNewWorkName);
+ if(ret)
+ err = errno;
+
+ return ret;
+ };
+ virtual int Setmode(int handle, int mode, int &err)
+ {
+ CALLFUNCRET(win32_setmode(handle, mode))
+ };
+ virtual int NameStat(const char *path, struct stat *buffer, int &err)
+ {
+ return win32_stat(path, buffer);
+ };
+ virtual char *Tmpnam(char *string, int &err)
+ {
+ return tmpnam(string);
+ };
+ virtual int Umask(int pmode, int &err)
+ {
+ return umask(pmode);
+ };
+ virtual int Unlink(const char *filename, int &err)
+ {
+ chmod(filename, S_IREAD | S_IWRITE);
+ CALLFUNCRET(unlink(filename))
+ };
+ virtual int Utime(char *filename, struct utimbuf *times, int &err)
+ {
+ CALLFUNCRET(win32_utime(filename, times))
+ };
+ virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
+ {
+ CALLFUNCERR(win32_write(handle, buffer, count))
+ };
+};
+
+class CPerlMem : public IPerlMem
+{
+public:
+ CPerlMem() {};
+ virtual void* Malloc(size_t size)
+ {
+ return win32_malloc(size);
+ };
+ virtual void* Realloc(void* ptr, size_t size)
+ {
+ return win32_realloc(ptr, size);
+ };
+ virtual void Free(void* ptr)
+ {
+ win32_free(ptr);
+ };
+};
+
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+
+extern char * g_getlogin(void);
+extern int do_spawn2(char *cmd, int exectype);
+extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
+
+class CPerlProc : public IPerlProc
+{
+public:
+ CPerlProc() {};
+ virtual void Abort(void)
+ {
+ win32_abort();
+ };
+ virtual void Exit(int status)
+ {
+ exit(status);
+ };
+ virtual void _Exit(int status)
+ {
+ _exit(status);
+ };
+ virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+ {
+ return execl(cmdname, arg0, arg1, arg2, arg3);
+ };
+ virtual int Execv(const char *cmdname, const char *const *argv)
+ {
+ return win32_execvp(cmdname, argv);
+ };
+ virtual int Execvp(const char *cmdname, const char *const *argv)
+ {
+ return win32_execvp(cmdname, argv);
+ };
+ virtual uid_t Getuid(void)
+ {
+ return getuid();
+ };
+ virtual uid_t Geteuid(void)
+ {
+ return geteuid();
+ };
+ virtual gid_t Getgid(void)
+ {
+ return getgid();
+ };
+ virtual gid_t Getegid(void)
+ {
+ return getegid();
+ };
+ virtual char *Getlogin(void)
+ {
+ return g_getlogin();
+ };
+ virtual int Kill(int pid, int sig)
+ {
+ return win32_kill(pid, sig);
+ };
+ virtual int Killpg(int pid, int sig)
+ {
+ croak("killpg not implemented!\n");
+ return 0;
+ };
+ virtual int PauseProc(void)
+ {
+ return win32_sleep((32767L << 16) + 32767);
+ };
+ virtual PerlIO* Popen(const char *command, const char *mode)
+ {
+ win32_fflush(stdout);
+ win32_fflush(stderr);
+ return (PerlIO*)win32_popen(command, mode);
+ };
+ virtual int Pclose(PerlIO *stream)
+ {
+ return win32_pclose((FILE*)stream);
+ };
+ virtual int Pipe(int *phandles)
+ {
+ return win32_pipe(phandles, 512, O_BINARY);
+ };
+ virtual int Setuid(uid_t u)
+ {
+ return setuid(u);
+ };
+ virtual int Setgid(gid_t g)
+ {
+ return setgid(g);
+ };
+ virtual int Sleep(unsigned int s)
+ {
+ return win32_sleep(s);
+ };
+ virtual int Times(struct tms *timebuf)
+ {
+ return win32_times(timebuf);
+ };
+ virtual int Wait(int *status)
+ {
+ return win32_wait(status);
+ };
+ virtual int Waitpid(int pid, int *status, int flags)
+ {
+ return win32_waitpid(pid, status, flags);
+ };
+ virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
+ {
+ return 0;
+ };
+ virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
+ {
+ dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
+ |FORMAT_MESSAGE_IGNORE_INSERTS
+ |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
+ dwErr, 0, (char *)&sMsg, 1, NULL);
+ if (0 < dwLen) {
+ while (0 < dwLen && isspace(sMsg[--dwLen]))
+ ;
+ if ('.' != sMsg[dwLen])
+ dwLen++;
+ sMsg[dwLen]= '\0';
+ }
+ if (0 == dwLen) {
+ sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+ dwLen = sprintf(sMsg,
+ "Unknown error #0x%lX (lookup 0x%lX)",
+ dwErr, GetLastError());
+ }
+ };
+ virtual void FreeBuf(char* sMsg)
+ {
+ LocalFree(sMsg);
+ };
+ virtual BOOL DoCmd(char *cmd)
+ {
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
+ };
+ virtual int Spawn(char* cmds)
+ {
+ return do_spawn2(cmds, EXECF_SPAWN);
+ };
+ virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
+ {
+ return win32_spawnvp(mode, cmdname, argv);
+ };
+ virtual int ASpawn(void *vreally, void **vmark, void **vsp)
+ {
+ return g_do_aspawn(vreally, vmark, vsp);
+ };
+};
+
+
+class CPerlStdIO : public IPerlStdIO
+{
+public:
+ CPerlStdIO() {};
+ virtual PerlIO* Stdin(void)
+ {
+ return (PerlIO*)win32_stdin();
+ };
+ virtual PerlIO* Stdout(void)
+ {
+ return (PerlIO*)win32_stdout();
+ };
+ virtual PerlIO* Stderr(void)
+ {
+ return (PerlIO*)win32_stderr();
+ };
+ virtual PerlIO* Open(const char *path, const char *mode, int &err)
+ {
+ PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual int Close(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fclose(((FILE*)pf)))
+ };
+ virtual int Eof(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_feof((FILE*)pf))
+ };
+ virtual int Error(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_ferror((FILE*)pf))
+ };
+ virtual void Clearerr(PerlIO* pf, int &err)
+ {
+ win32_clearerr((FILE*)pf);
+ };
+ virtual int Getc(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_getc((FILE*)pf))
+ };
+ virtual char* GetBase(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_base(f);
+ };
+ virtual int GetBufsiz(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_bufsiz(f);
+ };
+ virtual int GetCnt(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_cnt(f);
+ };
+ virtual char* GetPtr(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_ptr(f);
+ };
+ virtual char* Gets(PerlIO* pf, char* s, int n, int& err)
+ {
+ char* ret = win32_fgets(s, n, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return ret;
+ };
+ virtual int Putc(PerlIO* pf, int c, int &err)
+ {
+ CALLFUNCERR(win32_fputc(c, (FILE*)pf))
+ };
+ virtual int Puts(PerlIO* pf, const char *s, int &err)
+ {
+ CALLFUNCERR(win32_fputs(s, (FILE*)pf))
+ };
+ virtual int Flush(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fflush((FILE*)pf))
+ };
+ virtual int Ungetc(PerlIO* pf,int c, int &err)
+ {
+ CALLFUNCERR(win32_ungetc(c, (FILE*)pf))
+ };
+ virtual int Fileno(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fileno((FILE*)pf))
+ };
+ virtual PerlIO* Fdopen(int fd, const char *mode, int &err)
+ {
+ PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode);
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err)
+ {
+ PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return newPf;
+ };
+ virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err)
+ {
+ SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err)
+ {
+ SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void SetBuf(PerlIO* pf, char* buffer, int &err)
+ {
+ win32_setbuf((FILE*)pf, buffer);
+ };
+ virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err)
+ {
+ int i = win32_setvbuf((FILE*)pf, buffer, type, size);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void SetCnt(PerlIO* pf, int n, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ FILE_cnt(f) = n;
+ };
+ virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
+ {
+ FILE *f = (FILE*)pf;
+ FILE_ptr(f) = ptr;
+ FILE_cnt(f) = n;
+ };
+ virtual void Setlinebuf(PerlIO* pf, int &err)
+ {
+ win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
+ };
+ virtual int Printf(PerlIO* pf, int &err, const char *format,...)
+ {
+ va_list(arglist);
+ va_start(arglist, format);
+ int i = win32_vfprintf((FILE*)pf, format, arglist);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist)
+ {
+ int i = win32_vfprintf((FILE*)pf, format, arglist);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual long Tell(PerlIO* pf, int &err)
+ {
+ long l = win32_ftell((FILE*)pf);
+ if(errno)
+ err = errno;
+ return l;
+ };
+ virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err)
+ {
+ int i = win32_fseek((FILE*)pf, offset, origin);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void Rewind(PerlIO* pf, int &err)
+ {
+ win32_rewind((FILE*)pf);
+ };
+ virtual PerlIO* Tmpfile(int &err)
+ {
+ PerlIO* pf = (PerlIO*)win32_tmpfile();
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err)
+ {
+ int i = win32_fgetpos((FILE*)pf, p);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err)
+ {
+ int i = win32_fsetpos((FILE*)pf, p);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void Init(int &err)
+ {
+ };
+ virtual void InitOSExtras(void* p)
+ {
+ Perl_init_os_extras();
+ };
+ virtual int OpenOSfhandle(long osfhandle, int flags)
+ {
+ return win32_open_osfhandle(osfhandle, flags);
+ }
+ virtual int GetOSfhandle(int filenum)
+ {
+ return win32_get_osfhandle(filenum);
+ }
+};
+
+class CPerlHost
+{
+public:
+ CPerlHost() { pPerl = NULL; };
+ inline BOOL PerlCreate(void)
+ {
+ try
+ {
+ pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
+ &perlDir, &perlSock, &perlProc);
+ if(pPerl != NULL)
+ {
+ try
+ {
+ pPerl->perl_construct();
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "%s\n",
+ "Error: Unable to construct data structures");
+ pPerl->perl_free();
+ pPerl = NULL;
+ }
+ }
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
+ pPerl = NULL;
+ }
+ return (pPerl != NULL);
+ };
+ inline int PerlParse(void (*xs_init)(CPerlObj*), int argc, char** argv, char** env)
+ {
+ int retVal;
+ try
+ {
+ retVal = pPerl->perl_parse(xs_init, argc, argv, env);
+ }
+ catch(int x)
+ {
+ // this is where exit() should arrive
+ retVal = x;
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "Error: Parse exception\n");
+ retVal = -1;
+ }
+ *win32_errno() = 0;
+ return retVal;
+ };
+ inline int PerlRun(void)
+ {
+ int retVal;
+ try
+ {
+ retVal = pPerl->perl_run();
+ }
+ catch(int x)
+ {
+ // this is where exit() should arrive
+ retVal = x;
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "Error: Runtime exception\n");
+ retVal = -1;
+ }
+ return retVal;
+ };
+ inline void PerlDestroy(void)
+ {
+ try
+ {
+ pPerl->perl_destruct();
+ pPerl->perl_free();
+ }
+ catch(...)
+ {
+ }
+ };
+
+protected:
+ CPerlDir perlDir;
+ CPerlEnv perlEnv;
+ CPerlLIO perlLIO;
+ CPerlMem perlMem;
+ CPerlProc perlProc;
+ CPerlSock perlSock;
+ CPerlStdIO perlStdIO;
+};
#define NO_XSLOCKS
#include "XSUB.H"
-#include "Win32iop.h"
-
-#define errno (*win32_errno())
-#define stdout (win32_stdout())
-#define stderr (win32_stderr())
-
-CPerlObj *pPerl;
+#include "win32iop.h"
#include <fcntl.h>
-#include <ipdir.h>
-#include <ipenv.h>
-#include <ipsock.h>
-#include <iplio.h>
-#include <ipmem.h>
-#include <ipproc.h>
-#include <ipstdio.h>
-
-#define CALLFUNC0RET(x)\
- int ret = x;\
- if(ret < 0)\
- err = errno;\
- return ret;
-
-extern int g_closedir(DIR *dirp);
-extern DIR *g_opendir(char *filename);
-extern struct direct *g_readdir(DIR *dirp);
-extern void g_rewinddir(DIR *dirp);
-extern void g_seekdir(DIR *dirp, long loc);
-extern long g_telldir(DIR *dirp);
-class CPerlDir : public IPerlDir
-{
-public:
- CPerlDir() {};
- virtual int Makedir(const char *dirname, int mode, int &err)
- {
- CALLFUNC0RET(win32_mkdir(dirname, mode));
- };
- virtual int Chdir(const char *dirname, int &err)
- {
- CALLFUNC0RET(win32_chdir(dirname));
- };
- virtual int Rmdir(const char *dirname, int &err)
- {
- CALLFUNC0RET(win32_rmdir(dirname));
- };
- virtual int Close(DIR *dirp, int &err)
- {
- return g_closedir(dirp);
- };
- virtual DIR *Open(char *filename, int &err)
- {
- return g_opendir(filename);
- };
- virtual struct direct *Read(DIR *dirp, int &err)
- {
- return g_readdir(dirp);
- };
- virtual void Rewind(DIR *dirp, int &err)
- {
- g_rewinddir(dirp);
- };
- virtual void Seek(DIR *dirp, long loc, int &err)
- {
- g_seekdir(dirp, loc);
- };
- virtual long Tell(DIR *dirp, int &err)
- {
- return g_telldir(dirp);
- };
-};
-
-
-extern char * g_win32_get_privlib(char *pl);
-extern char * g_win32_get_sitelib(char *pl);
-class CPerlEnv : public IPerlEnv
-{
-public:
- CPerlEnv() {};
- virtual char *Getenv(const char *varname, int &err)
- {
- return win32_getenv(varname);
- };
- virtual int Putenv(const char *envstring, int &err)
- {
- return putenv(envstring);
- };
- virtual char* LibPath(char *pl)
- {
- return g_win32_get_privlib(pl);
- };
- virtual char* SiteLibPath(char *pl)
- {
- return g_win32_get_sitelib(pl);
- };
-};
-
-#define PROCESS_AND_RETURN \
- if(errno) \
- err = errno; \
- return r
-
-class CPerlSock : public IPerlSock
-{
-public:
- CPerlSock() {};
- virtual u_long Htonl(u_long hostlong)
- {
- return win32_htonl(hostlong);
- };
- virtual u_short Htons(u_short hostshort)
- {
- return win32_htons(hostshort);
- };
- virtual u_long Ntohl(u_long netlong)
- {
- return win32_ntohl(netlong);
- };
- virtual u_short Ntohs(u_short netshort)
- {
- return win32_ntohs(netshort);
- }
-
- virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
- {
- SOCKET r = win32_accept(s, addr, addrlen);
- PROCESS_AND_RETURN;
- };
- virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err)
- {
- int r = win32_bind(s, name, namelen);
- PROCESS_AND_RETURN;
- };
- virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err)
- {
- int r = win32_connect(s, name, namelen);
- PROCESS_AND_RETURN;
- };
- virtual void Endhostent(int &err)
- {
- win32_endhostent();
- };
- virtual void Endnetent(int &err)
- {
- win32_endnetent();
- };
- virtual void Endprotoent(int &err)
- {
- win32_endprotoent();
- };
- virtual void Endservent(int &err)
- {
- win32_endservent();
- };
- virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err)
- {
- struct hostent *r = win32_gethostbyaddr(addr, len, type);
- PROCESS_AND_RETURN;
- };
- virtual struct hostent* Gethostbyname(const char* name, int &err)
- {
- struct hostent *r = win32_gethostbyname(name);
- PROCESS_AND_RETURN;
- };
- virtual struct hostent* Gethostent(int &err)
- {
- croak("gethostent not implemented!\n");
- return NULL;
- };
- virtual int Gethostname(char* name, int namelen, int &err)
- {
- int r = win32_gethostname(name, namelen);
- PROCESS_AND_RETURN;
- };
- virtual struct netent *Getnetbyaddr(long net, int type, int &err)
- {
- struct netent *r = win32_getnetbyaddr(net, type);
- PROCESS_AND_RETURN;
- };
- virtual struct netent *Getnetbyname(const char *name, int &err)
- {
- struct netent *r = win32_getnetbyname((char*)name);
- PROCESS_AND_RETURN;
- };
- virtual struct netent *Getnetent(int &err)
- {
- struct netent *r = win32_getnetent();
- PROCESS_AND_RETURN;
- };
- virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err)
- {
- int r = win32_getpeername(s, name, namelen);
- PROCESS_AND_RETURN;
- };
- virtual struct protoent* Getprotobyname(const char* name, int &err)
- {
- struct protoent *r = win32_getprotobyname(name);
- PROCESS_AND_RETURN;
- };
- virtual struct protoent* Getprotobynumber(int number, int &err)
- {
- struct protoent *r = win32_getprotobynumber(number);
- PROCESS_AND_RETURN;
- };
- virtual struct protoent* Getprotoent(int &err)
- {
- struct protoent *r = win32_getprotoent();
- PROCESS_AND_RETURN;
- };
- virtual struct servent* Getservbyname(const char* name, const char* proto, int &err)
- {
- struct servent *r = win32_getservbyname(name, proto);
- PROCESS_AND_RETURN;
- };
- virtual struct servent* Getservbyport(int port, const char* proto, int &err)
- {
- struct servent *r = win32_getservbyport(port, proto);
- PROCESS_AND_RETURN;
- };
- virtual struct servent* Getservent(int &err)
- {
- struct servent *r = win32_getservent();
- PROCESS_AND_RETURN;
- };
- virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err)
- {
- int r = win32_getsockname(s, name, namelen);
- PROCESS_AND_RETURN;
- };
- virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
- {
- int r = win32_getsockopt(s, level, optname, optval, optlen);
- PROCESS_AND_RETURN;
- };
- virtual unsigned long InetAddr(const char* cp, int &err)
- {
- unsigned long r = win32_inet_addr(cp);
- PROCESS_AND_RETURN;
- };
- virtual char* InetNtoa(struct in_addr in, int &err)
- {
- char *r = win32_inet_ntoa(in);
- PROCESS_AND_RETURN;
- };
- virtual int Listen(SOCKET s, int backlog, int &err)
- {
- int r = win32_listen(s, backlog);
- PROCESS_AND_RETURN;
- };
- virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err)
- {
- int r = win32_recv(s, buffer, len, flags);
- PROCESS_AND_RETURN;
- };
- virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
- {
- int r = win32_recvfrom(s, buffer, len, flags, from, fromlen);
- PROCESS_AND_RETURN;
- };
- virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err)
- {
- int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
- PROCESS_AND_RETURN;
- };
- virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err)
- {
- int r = win32_send(s, buffer, len, flags);
- PROCESS_AND_RETURN;
- };
- virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
- {
- int r = win32_sendto(s, buffer, len, flags, to, tolen);
- PROCESS_AND_RETURN;
- };
- virtual void Sethostent(int stayopen, int &err)
- {
- win32_sethostent(stayopen);
- };
- virtual void Setnetent(int stayopen, int &err)
- {
- win32_setnetent(stayopen);
- };
- virtual void Setprotoent(int stayopen, int &err)
- {
- win32_setprotoent(stayopen);
- };
- virtual void Setservent(int stayopen, int &err)
- {
- win32_setservent(stayopen);
- };
- virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
- {
- int r = win32_setsockopt(s, level, optname, optval, optlen);
- PROCESS_AND_RETURN;
- };
- virtual int Shutdown(SOCKET s, int how, int &err)
- {
- int r = win32_shutdown(s, how);
- PROCESS_AND_RETURN;
- };
- virtual SOCKET Socket(int af, int type, int protocol, int &err)
- {
- SOCKET r = win32_socket(af, type, protocol);
- PROCESS_AND_RETURN;
- };
- virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err)
- {
- croak("socketpair not implemented!\n");
- return 0;
- };
- virtual int Closesocket(SOCKET s, int& err)
- {
- int r = win32_closesocket(s);
- PROCESS_AND_RETURN;
- };
- virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err)
- {
- int r = win32_ioctlsocket(s, cmd, argp);
- PROCESS_AND_RETURN;
- };
-};
-
+#include "perlhost.h"
-#define CALLFUNCRET(x)\
- int ret = x;\
- if(ret)\
- err = errno;\
- return ret;
-#define CALLFUNCERR(x)\
- int ret = x;\
- if(errno)\
- err = errno;\
- return ret;
-
-#define LCALLFUNCERR(x)\
- long ret = x;\
- if(errno)\
- err = errno;\
- return ret;
-
-class CPerlLIO : public IPerlLIO
-{
-public:
- CPerlLIO() {};
- virtual int Access(const char *path, int mode, int &err)
- {
- CALLFUNCRET(access(path, mode))
- };
- virtual int Chmod(const char *filename, int pmode, int &err)
- {
- CALLFUNCRET(chmod(filename, pmode))
- };
- virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err)
- {
- CALLFUNCERR(chown(filename, owner, group))
- };
- virtual int Chsize(int handle, long size, int &err)
- {
- CALLFUNCRET(chsize(handle, size))
- };
- virtual int Close(int handle, int &err)
- {
- CALLFUNCRET(win32_close(handle))
- };
- virtual int Dup(int handle, int &err)
- {
- CALLFUNCERR(win32_dup(handle))
- };
- virtual int Dup2(int handle1, int handle2, int &err)
- {
- CALLFUNCERR(win32_dup2(handle1, handle2))
- };
- virtual int Flock(int fd, int oper, int &err)
- {
- CALLFUNCERR(win32_flock(fd, oper))
- };
- virtual int FileStat(int handle, struct stat *buffer, int &err)
- {
- CALLFUNCERR(fstat(handle, buffer))
- };
- virtual int IOCtl(int i, unsigned int u, char *data, int &err)
- {
- CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
- };
- virtual int Isatty(int fd, int &err)
- {
- return isatty(fd);
- };
- virtual long Lseek(int handle, long offset, int origin, int &err)
- {
- LCALLFUNCERR(win32_lseek(handle, offset, origin))
- };
- virtual int Lstat(const char *path, struct stat *buffer, int &err)
- {
- return NameStat(path, buffer, err);
- };
- virtual char *Mktemp(char *Template, int &err)
- {
- return mktemp(Template);
- };
- virtual int Open(const char *filename, int oflag, int &err)
- {
- CALLFUNCERR(win32_open(filename, oflag))
- };
- virtual int Open(const char *filename, int oflag, int pmode, int &err)
- {
- int ret;
- if(stricmp(filename, "/dev/null") == 0)
- ret = open("NUL", oflag, pmode);
- else
- ret = open(filename, oflag, pmode);
-
- if(errno)
- err = errno;
- return ret;
- };
- virtual int Read(int handle, void *buffer, unsigned int count, int &err)
- {
- CALLFUNCERR(win32_read(handle, buffer, count))
- };
- virtual int Rename(const char *OldFileName, const char *newname, int &err)
- {
- char szNewWorkName[MAX_PATH+1];
- WIN32_FIND_DATA fdOldFile, fdNewFile;
- HANDLE handle;
- char *ptr;
-
- if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
- && strchr(newname, '\\') == NULL
- && strchr(newname, '/') == NULL)
- {
- strcpy(szNewWorkName, OldFileName);
- if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
- ptr = strrchr(szNewWorkName, '/');
- strcpy(++ptr, newname);
- }
- else
- strcpy(szNewWorkName, newname);
-
- if(stricmp(OldFileName, szNewWorkName) != 0)
- { // check that we're not being fooled by relative paths
- // and only delete the new file
- // 1) if it exists
- // 2) it is not the same file as the old file
- // 3) old file exist
- // GetFullPathName does not return the long file name on some systems
- handle = FindFirstFile(OldFileName, &fdOldFile);
- if(handle != INVALID_HANDLE_VALUE)
- {
- FindClose(handle);
-
- handle = FindFirstFile(szNewWorkName, &fdNewFile);
-
- if(handle != INVALID_HANDLE_VALUE)
- FindClose(handle);
- else
- fdNewFile.cFileName[0] = '\0';
-
- if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
- && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
- { // file exists and not same file
- DeleteFile(szNewWorkName);
- }
- }
- }
- int ret = rename(OldFileName, szNewWorkName);
- if(ret)
- err = errno;
-
- return ret;
- };
- virtual int Setmode(int handle, int mode, int &err)
- {
- CALLFUNCRET(win32_setmode(handle, mode))
- };
- virtual int NameStat(const char *path, struct stat *buffer, int &err)
- {
- return win32_stat(path, buffer);
- };
- virtual char *Tmpnam(char *string, int &err)
- {
- return tmpnam(string);
- };
- virtual int Umask(int pmode, int &err)
- {
- return umask(pmode);
- };
- virtual int Unlink(const char *filename, int &err)
- {
- chmod(filename, S_IREAD | S_IWRITE);
- CALLFUNCRET(unlink(filename))
- };
- virtual int Utime(char *filename, struct utimbuf *times, int &err)
- {
- CALLFUNCRET(win32_utime(filename, times))
- };
- virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
- {
- CALLFUNCERR(win32_write(handle, buffer, count))
- };
-};
-
-class CPerlMem : public IPerlMem
-{
-public:
- CPerlMem() {};
- virtual void* Malloc(size_t size)
- {
- return win32_malloc(size);
- };
- virtual void* Realloc(void* ptr, size_t size)
- {
- return win32_realloc(ptr, size);
- };
- virtual void Free(void* ptr)
- {
- win32_free(ptr);
- };
-};
-
-#define EXECF_EXEC 1
-#define EXECF_SPAWN 2
-
-extern char *g_getlogin(void);
-extern int do_spawn2(char *cmd, int exectype);
-extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
-class CPerlProc : public IPerlProc
-{
-public:
- CPerlProc() {};
- virtual void Abort(void)
- {
- win32_abort();
- };
- virtual void Exit(int status)
- {
- exit(status);
- };
- virtual void _Exit(int status)
- {
- _exit(status);
- };
- virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
- {
- return execl(cmdname, arg0, arg1, arg2, arg3);
- };
- virtual int Execv(const char *cmdname, const char *const *argv)
- {
- return win32_execvp(cmdname, argv);
- };
- virtual int Execvp(const char *cmdname, const char *const *argv)
- {
- return win32_execvp(cmdname, argv);
- };
- virtual uid_t Getuid(void)
- {
- return getuid();
- };
- virtual uid_t Geteuid(void)
- {
- return geteuid();
- };
- virtual gid_t Getgid(void)
- {
- return getgid();
- };
- virtual gid_t Getegid(void)
- {
- return getegid();
- };
- virtual char *Getlogin(void)
- {
- return g_getlogin();
- };
- virtual int Kill(int pid, int sig)
- {
- return win32_kill(pid, sig);
- };
- virtual int Killpg(int pid, int sig)
- {
- croak("killpg not implemented!\n");
- return 0;
- };
- virtual int PauseProc(void)
- {
- return win32_sleep((32767L << 16) + 32767);
- };
- virtual PerlIO* Popen(const char *command, const char *mode)
- {
- win32_fflush(stdout);
- win32_fflush(stderr);
- return (PerlIO*)win32_popen(command, mode);
- };
- virtual int Pclose(PerlIO *stream)
- {
- return win32_pclose((FILE*)stream);
- };
- virtual int Pipe(int *phandles)
- {
- return win32_pipe(phandles, 512, O_BINARY);
- };
- virtual int Setuid(uid_t u)
- {
- return setuid(u);
- };
- virtual int Setgid(gid_t g)
- {
- return setgid(g);
- };
- virtual int Sleep(unsigned int s)
- {
- return win32_sleep(s);
- };
- virtual int Times(struct tms *timebuf)
- {
- return win32_times(timebuf);
- };
- virtual int Wait(int *status)
- {
- return win32_wait(status);
- };
- virtual int Waitpid(int pid, int *status, int flags)
- {
- return win32_waitpid(pid, status, flags);
- };
- virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
- {
- return 0;
- };
- virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
- {
- dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
- |FORMAT_MESSAGE_IGNORE_INSERTS
- |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
- dwErr, 0, (char *)&sMsg, 1, NULL);
- if (0 < dwLen) {
- while (0 < dwLen && isspace(sMsg[--dwLen]))
- ;
- if ('.' != sMsg[dwLen])
- dwLen++;
- sMsg[dwLen]= '\0';
- }
- if (0 == dwLen) {
- sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
- dwLen = sprintf(sMsg,
- "Unknown error #0x%lX (lookup 0x%lX)",
- dwErr, GetLastError());
- }
- };
- virtual void FreeBuf(char* sMsg)
- {
- LocalFree(sMsg);
- };
- virtual BOOL DoCmd(char *cmd)
- {
- do_spawn2(cmd, EXECF_EXEC);
- return FALSE;
- };
- virtual int Spawn(char* cmds)
- {
- return do_spawn2(cmds, EXECF_SPAWN);
- };
- virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
- {
- return win32_spawnvp(mode, cmdname, argv);
- };
- virtual int ASpawn(void *vreally, void **vmark, void **vsp)
- {
- return g_do_aspawn(vreally, vmark, vsp);
- };
-};
-
-
-class CPerlStdIO : public IPerlStdIO
-{
-public:
- CPerlStdIO() {};
- virtual PerlIO* Stdin(void)
- {
- return (PerlIO*)win32_stdin();
- };
- virtual PerlIO* Stdout(void)
- {
- return (PerlIO*)win32_stdout();
- };
- virtual PerlIO* Stderr(void)
- {
- return (PerlIO*)win32_stderr();
- };
- virtual PerlIO* Open(const char *path, const char *mode, int &err)
- {
- PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
- if(errno)
- err = errno;
- return pf;
- };
- virtual int Close(PerlIO* pf, int &err)
- {
- CALLFUNCERR(win32_fclose(((FILE*)pf)))
- };
- virtual int Eof(PerlIO* pf, int &err)
- {
- CALLFUNCERR(win32_feof((FILE*)pf))
- };
- virtual int Error(PerlIO* pf, int &err)
- {
- CALLFUNCERR(win32_ferror((FILE*)pf))
- };
- virtual void Clearerr(PerlIO* pf, int &err)
- {
- win32_clearerr((FILE*)pf);
- };
- virtual int Getc(PerlIO* pf, int &err)
- {
- CALLFUNCERR(win32_getc((FILE*)pf))
- };
- virtual char* GetBase(PerlIO* pf, int &err)
- {
- FILE *f = (FILE*)pf;
- return FILE_base(f);
- };
- virtual int GetBufsiz(PerlIO* pf, int &err)
- {
- FILE *f = (FILE*)pf;
- return FILE_bufsiz(f);
- };
- virtual int GetCnt(PerlIO* pf, int &err)
- {
- FILE *f = (FILE*)pf;
- return FILE_cnt(f);
- };
- virtual char* GetPtr(PerlIO* pf, int &err)
- {
- FILE *f = (FILE*)pf;
- return FILE_ptr(f);
- };
- virtual char* Gets(PerlIO* pf, char* s, int n, int& err)
- {
- char* ret = win32_fgets(s, n, (FILE*)pf);
- if(errno)
- err = errno;
- return ret;
- };
- virtual int Putc(PerlIO* pf, int c, int &err)
- {
- CALLFUNCERR(win32_fputc(c, (FILE*)pf))
- };
- virtual int Puts(PerlIO* pf, const char *s, int &err)
- {
- CALLFUNCERR(win32_fputs(s, (FILE*)pf))
- };
- virtual int Flush(PerlIO* pf, int &err)
- {
- CALLFUNCERR(win32_fflush((FILE*)pf))
- };
- virtual int Ungetc(PerlIO* pf,int c, int &err)
- {
- CALLFUNCERR(win32_ungetc(c, (FILE*)pf))
- };
- virtual int Fileno(PerlIO* pf, int &err)
- {
- CALLFUNCERR(win32_fileno((FILE*)pf))
- };
- virtual PerlIO* Fdopen(int fd, const char *mode, int &err)
- {
- PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode);
- if(errno)
- err = errno;
- return pf;
- };
- virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err)
- {
- PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
- if(errno)
- err = errno;
- return newPf;
- };
- virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err)
- {
- SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf);
- if(errno)
- err = errno;
- return i;
- };
- virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err)
- {
- SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf);
- if(errno)
- err = errno;
- return i;
- };
- virtual void SetBuf(PerlIO* pf, char* buffer, int &err)
- {
- win32_setbuf((FILE*)pf, buffer);
- };
- virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err)
- {
- int i = win32_setvbuf((FILE*)pf, buffer, type, size);
- if(errno)
- err = errno;
- return i;
- };
- virtual void SetCnt(PerlIO* pf, int n, int &err)
- {
- FILE *f = (FILE*)pf;
- FILE_cnt(f) = n;
- };
- virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
- {
- FILE *f = (FILE*)pf;
- FILE_ptr(f) = ptr;
- FILE_cnt(f) = n;
- };
- virtual void Setlinebuf(PerlIO* pf, int &err)
- {
- win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
- };
- virtual int Printf(PerlIO* pf, int &err, const char *format,...)
- {
- va_list(arglist);
- va_start(arglist, format);
- int i = win32_vfprintf((FILE*)pf, format, arglist);
- if(errno)
- err = errno;
- return i;
- };
- virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist)
- {
- int i = win32_vfprintf((FILE*)pf, format, arglist);
- if(errno)
- err = errno;
- return i;
- };
- virtual long Tell(PerlIO* pf, int &err)
- {
- long l = win32_ftell((FILE*)pf);
- if(errno)
- err = errno;
- return l;
- };
- virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err)
- {
- int i = win32_fseek((FILE*)pf, offset, origin);
- if(errno)
- err = errno;
- return i;
- };
- virtual void Rewind(PerlIO* pf, int &err)
- {
- win32_rewind((FILE*)pf);
- };
- virtual PerlIO* Tmpfile(int &err)
- {
- PerlIO* pf = (PerlIO*)win32_tmpfile();
- if(errno)
- err = errno;
- return pf;
- };
- virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err)
- {
- int i = win32_fgetpos((FILE*)pf, p);
- if(errno)
- err = errno;
- return i;
- };
- virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err)
- {
- int i = win32_fsetpos((FILE*)pf, p);
- if(errno)
- err = errno;
- return i;
- };
- virtual void Init(int &err)
- {
- };
- virtual void InitOSExtras(void* p)
- {
- Perl_init_os_extras();
- };
- virtual int OpenOSfhandle(long osfhandle, int flags)
- {
- return win32_open_osfhandle(osfhandle, flags);
- }
- virtual int GetOSfhandle(int filenum)
- {
- return win32_get_osfhandle(filenum);
- }
+char *staticlinkmodules[] = {
+ "DynaLoader",
+ NULL,
};
+EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
-static void xs_init _((CPERLarg));
-
-class CPerlHost
+static void
+xs_init(CPERLarg)
{
-public:
- CPerlHost() { pPerl = NULL; };
- inline BOOL PerlCreate(void)
- {
- try
- {
- pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc);
- if(pPerl != NULL)
- {
- try
- {
- pPerl->perl_construct();
- }
- catch(...)
- {
- win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
- pPerl->perl_free();
- pPerl = NULL;
- }
- }
- }
- catch(...)
- {
- win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
- pPerl = NULL;
- }
- return (pPerl != NULL);
- };
- inline int PerlParse(int argc, char** argv, char** env)
- {
- int retVal;
- try
- {
- retVal = pPerl->perl_parse(xs_init, argc, argv, env);
- }
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
- }
- catch(...)
- {
- win32_fprintf(stderr, "Error: Parse exception\n");
- retVal = -1;
- }
- *win32_errno() = 0;
- return retVal;
- };
- inline int PerlRun(void)
- {
- int retVal;
- try
- {
- retVal = pPerl->perl_run();
- }
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
- }
- catch(...)
- {
- win32_fprintf(stderr, "Error: Runtime exception\n");
- retVal = -1;
- }
- return retVal;
- };
- inline void PerlDestroy(void)
- {
- try
- {
- pPerl->perl_destruct();
- pPerl->perl_free();
- }
- catch(...)
- {
- }
- };
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
-protected:
- CPerlDir perlDir;
- CPerlEnv perlEnv;
- CPerlLIO perlLIO;
- CPerlMem perlMem;
- CPerlProc perlProc;
- CPerlSock perlSock;
- CPerlStdIO perlStdIO;
-};
+CPerlObj *pPerl;
#undef PERL_SYS_INIT
#define PERL_SYS_INIT(a, c)
if(!host.PerlCreate())
exit(exitstatus);
-
- exitstatus = host.PerlParse(argc, argv, NULL);
+ exitstatus = host.PerlParse(xs_init, argc, argv, NULL);
if (!exitstatus)
- {
exitstatus = host.PerlRun();
- }
host.PerlDestroy();
return exitstatus;
}
-char *staticlinkmodules[] = {
- "DynaLoader",
- NULL,
-};
-
-EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
-
-static void
-xs_init(CPERLarg)
-{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
-
#else /* PERL_OBJECT */
#ifdef __GNUC__
typedef long gid_t;
#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
+#ifndef PERL_OBJECT
+
+/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
+#define STRUCT_MGVTBL_DEFINITION \
+struct mgvtbl { \
+ union { \
+ int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem1[16]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem2[16]; \
+ }; \
+ union { \
+ U32 (CPERLscope(*svt_len)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem3[16]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem4[16]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg)); \
+ char handle_VC_problem5[16]; \
+ }; \
+}
+
+#define BASEOP_DEFINITION \
+ OP* op_next; \
+ OP* op_sibling; \
+ OP* (CPERLscope(*op_ppaddr))_((ARGSproto)); \
+ char handle_VC_problem[12]; \
+ PADOFFSET op_targ; \
+ OPCODE op_type; \
+ U16 op_seq; \
+ U8 op_flags; \
+ U8 op_private;
+
+#define UNION_ANY_DEFINITION union any { \
+ void* any_ptr; \
+ I32 any_i32; \
+ IV any_iv; \
+ long any_long; \
+ void (CPERLscope(*any_dptr)) _((void*)); \
+ char handle_VC_problem[16]; \
+}
+
+#endif /* PERL_OBJECT */
+
#endif /* _MSC_VER */
#ifdef __MINGW32__ /* Minimal Gnu-Win32 */
projects / platform / upstream / perl.git / commitdiff