return PerlIO_fdopen(p[This], mode);
}
#else
-#if defined(atarist) || defined(DJGPP)
+#if defined(atarist)
FILE *popen();
PerlIO *
Perl_my_popen(pTHX_ char *cmd, char *mode)
*/
return PerlIO_importFILE(popen(cmd, mode), 0);
}
+#else
+#if defined(DJGPP)
+FILE *djgpp_popen();
+PerlIO *
+Perl_my_popen(pTHX_ char *cmd, char *mode)
+{
+ PERL_FLUSHALL_FOR_CHILD;
+ /* Call system's popen() to get a FILE *, then import it.
+ used 0 for 2nd parameter to PerlIO_importFILE;
+ apparently not used
+ */
+ return PerlIO_importFILE(djgpp_popen(cmd, mode), 0);
+}
+#endif
#endif
#endif /* !DOSISH */
return;
}
-#if defined(atarist) || defined(OS2) || defined(DJGPP)
+#if defined(atarist) || defined(OS2)
int pclose();
#ifdef HAS_FORK
int /* Cannot prototype with I32
/* Needs work for PerlIO ! */
FILE *f = PerlIO_findFILE(ptr);
I32 result = pclose(f);
+ PerlIO_releaseFILE(ptr,f);
+ return result;
+}
+#endif
+
#if defined(DJGPP)
+int djgpp_pclose();
+I32
+Perl_my_pclose(pTHX_ PerlIO *ptr)
+{
+ /* Needs work for PerlIO ! */
+ FILE *f = PerlIO_findFILE(ptr);
+ I32 result = djgpp_pclose(f);
result = (result << 8) & 0xff00;
-#endif
PerlIO_releaseFILE(ptr,f);
return result;
}
mg->mg_len = sizeof(cp);
UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */
DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
- "%p: condpair_magic %p\n", thr, sv));)
+ "%p: condpair_magic %p\n", thr, sv)));
}
}
return mg;
MgOWNER(mg) = thr;
DEBUG_S(PerlIO_printf(Perl_debug_log,
"0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv));)
+ PTR2UV(thr), PTR2UV(sv)));
MUTEX_UNLOCK(MgMUTEXP(mg));
SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
(dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
/*
-=for apidoc sv_getcwd
+=for apidoc getcwd_sv
Fill the sv with current working directory
* back into. */
int
-Perl_sv_getcwd(pTHX_ register SV *sv)
+Perl_getcwd_sv(pTHX_ register SV *sv)
{
#ifndef PERL_MICRO
#ifdef HAS_GETCWD
{
- char* buf;
-
- SvPOK_off(sv);
- New(0, buf, MAXPATHLEN, char);
- if (buf) {
- buf[MAXPATHLEN] = 0;
- /* Yes, some getcwd()s automatically allocate a buffer
- * if given a NULL one. Portability is the problem.
- * XXX Configure probe needed. */
- if (getcwd(buf, MAXPATHLEN - 1)) {
- STRLEN len = strlen(buf);
- sv_setpvn(sv, buf, len);
- SvPOK_only(sv);
- SvCUR_set(sv, len);
- }
- else
- sv_setsv(sv, &PL_sv_undef);
- Safefree(buf);
- }
- else
- sv_setsv(sv, &PL_sv_undef);
-
- return SvPOK(sv) ? TRUE : FALSE;
+ char buf[MAXPATHLEN];
+
+ /* Some getcwd()s automatically allocate a buffer of the given
+ * size from the heap if they are given a NULL buffer pointer.
+ * The problem is that this behaviour is not portable. */
+ if (getcwd(buf, sizeof(buf) - 1)) {
+ STRLEN len = strlen(buf);
+ sv_setpvn(sv, buf, len);
+ return TRUE;
+ }
+ else {
+ sv_setsv(sv, &PL_sv_undef);
+ return FALSE;
+ }
}
#else
#endif
}
- SvCUR_set(sv, pathlen);
- *SvEND(sv) = '\0';
- SvPOK_only(sv);
+ if (pathlen) {
+ SvCUR_set(sv, pathlen);
+ *SvEND(sv) = '\0';
+ SvPOK_only(sv);
- if (PerlDir_chdir(SvPVX(sv)) < 0) {
- SV_CWD_RETURN_UNDEF;
+ if (PerlDir_chdir(SvPVX(sv)) < 0) {
+ SV_CWD_RETURN_UNDEF;
+ }
}
if (PerlLIO_stat(".", &statbuf) < 0) {
SV_CWD_RETURN_UNDEF;