diff options
Diffstat (limited to 'os2')
| -rw-r--r-- | os2/Changes | 8 | ||||
| -rw-r--r-- | os2/Makefile.SHs | 2 | ||||
| -rw-r--r-- | os2/os2.c | 47 | ||||
| -rw-r--r-- | os2/os2ish.h | 5 |
4 files changed, 58 insertions, 4 deletions
diff --git a/os2/Changes b/os2/Changes index 9a9524f161..2bd48b2942 100644 --- a/os2/Changes +++ b/os2/Changes @@ -104,3 +104,11 @@ after 5.003_05: perl___ - cannot fork, can dynalink. The build of the first one - perl - is rather convoluted, and requires a build of miniperl_. + +after 5.003_07: + custom tmpfile and tmpname which may use $TMP, $TEMP. + all the calls to OS/2 API wrapped so that it is safe to use + them under DOS (may die(), though). + Tested that popen works under DOS with modified PDKSH and RSX. + File::Copy works under DOS. + MakeMaker modified to work under DOS (perlmain.c.tmp and sh -c true). diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index a1fcaa49ed..c498706627 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -49,6 +49,8 @@ perl5.def: perl.linkexp echo ' "dlsym"' >>$@ echo ' "dlerror"' >>$@ echo ' "perl_init_i18nl10n"' >>$@ + echo ' "my_tmpfile"' >>$@ + echo ' "my_tmpnam"' >>$@ !NO!SUBS! if [ ! -z "$myttyname" ] ; then @@ -73,6 +73,7 @@ setpriority(int which, int pid, int val) prio = sys_prio(pid); + if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */ if (priors[(32 - val) >> 5] + 1 == (prio >> 8)) { /* Do not change class. */ return CheckOSError(DosSetPriority((pid < 0) @@ -114,6 +115,7 @@ getpriority(int which /* ignored */, int pid) PIB *pib; ULONG rc, ret; + if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */ /* DosGetInfoBlocks has old priority! */ /* if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) return -1; */ /* if (pid != pib->pib_ulpid) { */ @@ -409,6 +411,8 @@ tcp0(char *name) { static BYTE buf[20]; PFN fcn; + + if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */ if (!htcp) DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp); if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0) @@ -421,6 +425,8 @@ tcp1(char *name, int arg) { static BYTE buf[20]; PFN fcn; + + if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */ if (!htcp) DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp); if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0) @@ -601,6 +607,7 @@ os2error(int rc) static char buf[300]; ULONG len; + if (!(_emx_env & 0x200)) return ""; /* Nop if not OS/2. */ if (rc == 0) return NULL; if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, rc, "OSO001.MSG", &len)) @@ -947,8 +954,12 @@ Xs_OS2_init() char *file = __FILE__; { GV *gv; - - newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file); + + if (_emx_env & 0x200) { /* OS/2 */ + newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file); + newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file); + newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file); + } newXS("DynaLoader::mod2fname", XS_DynaLoader_mod2fname, file); newXS("Cwd::current_drive", XS_Cwd_current_drive, file); newXS("Cwd::sys_chdir", XS_Cwd_sys_chdir, file); @@ -958,8 +969,6 @@ Xs_OS2_init() newXS("Cwd::sys_is_relative", XS_Cwd_sys_is_relative, file); newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file); newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file); - newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file); - newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file); gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV); GvMULTI_on(gv); #ifdef PERL_IS_AOUT @@ -992,3 +1001,33 @@ Perl_OS2_init() } } +#undef tmpnam +#undef tmpfile + +char * +my_tmpnam (char *str) +{ + char *p = getenv("TMP"), *tpath; + int len; + + if (!p) p = getenv("TEMP"); + tpath = tempnam(p, "pltmp"); + if (str && tpath) { + strcpy(str, tpath); + return str; + } + return tpath; +} + +FILE * +my_tmpfile () +{ + struct stat s; + + stat(".", &s); + if (s.st_mode & S_IWOTH) { + return tmpfile(); + } + return fopen(my_tmpnam(NULL), "w+b"); /* Race condition, but + grants TMP. */ +} diff --git a/os2/os2ish.h b/os2/os2ish.h index 6510a1f145..0597fdcd39 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -99,6 +99,11 @@ extern char *tmppath; PerlIO *my_syspopen(char *cmd, char *mode); /* Cannot prototype with I32 at this point. */ int my_syspclose(PerlIO *f); +FILE *my_tmpfile (void); +char *my_tmpnam (char *); + +#define tmpfile my_tmpfile +#define tmpnam my_tmpnam /* * fwrite1() should be a routine with the same calling sequence as fwrite(), |