-#include <libc/stubs.h>
-#include <io.h>
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-#include <libc/file.h>
-#include <process.h>
-#include <fcntl.h>
-#include <glob.h>
-#include <sys/fsext.h>
-#include <crt0.h>
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
+#define PERLIO_NOT_STDIO 0
+#include "djgpp.h"
/* hold file pointer, command, mode, and the status of the command */
struct pipe_list {
static struct pipe_list *pl = NULL;
FILE *
-popen (const char *cm, const char *md) /* program name, pipe mode */
+djgpp_popen (const char *cm, const char *md) /* program name, pipe mode */
{
struct pipe_list *l1;
int fd;
}
int
-pclose (FILE *pp)
+djgpp_pclose (FILE *pp)
{
struct pipe_list *l1, **l2; /* list pointers */
int retval=-1; /* function return value */
convretcode (pTHX_ int rc,char *prog,int fl)
{
if (rc < 0 && ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s",
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s",
fl ? "exec" : "spawn",prog,Strerror (errno));
- if (rc > 0)
+ if (rc >= 0)
return rc << 8;
- if (rc < 0)
- return 255 << 8;
- return 0;
+ return -1;
}
int
do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
{
- dTHR;
int rc;
char **a,*tmps,**argv;
STRLEN n_a;
*a++ = SvPVx(*mark, n_a);
else
*a++ = "";
- *a = Nullch;
+ *a = NULL;
if (argv[0][0] != '/' && argv[0][0] != '\\'
&& !(argv[0][0] && argv[0][1] == ':'
return convretcode (system (cmd),cmd,execf);
}
- New (1303,PL_Argv,(s-cmd)/2+2,char*);
+ Newx (PL_Argv,(s-cmd)/2+2,char*);
PL_Cmd=savepvn (cmd,s-cmd);
a=PL_Argv;
for (s=PL_Cmd; *s;) {
if (*s)
*s++='\0';
}
- *a=Nullch;
+ *a=NULL;
if (!PL_Argv[0])
return -1;
}
bool
-Perl_do_exec (pTHX_ char *cmd)
+Perl_do_exec (pTHX_ const char *cmd)
{
do_spawn2 (aTHX_ cmd,EXECF_EXEC);
return FALSE;
ST(0)=sv_newmortal ();
if (getcwd (tmp,PATH_MAX+1)!=NULL)
sv_setpv ((SV*)ST(0),tmp);
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(ST(0));
+#endif
}
XSRETURN (1);
}
XSRETURN_IV (_USE_LFN);
}
+XS(XS_Cwd_sys_cwd)
+{
+ dXSARGS;
+ if (items != 0)
+ Perl_croak_nocontext("Usage: Cwd::sys_cwd()");
+ {
+ char p[MAXPATHLEN];
+ char * RETVAL;
+ RETVAL = getcwd(p, MAXPATHLEN);
+ ST(0) = sv_newmortal();
+ sv_setpv((SV*)ST(0), RETVAL);
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(ST(0));
+#endif
+ }
+ XSRETURN(1);
+}
+
void
Perl_init_os_extras(pTHX)
{
newXS ("Dos::GetCwd",dos_GetCwd,file);
newXS ("Dos::UseLFN",dos_UseLFN,file);
+ newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file);
/* install my File System Extension for globbing */
__FSEXT_add_open_handler (glob_handler);
#define PERL5 "/perl5"
-char *djgpp_pathexp (const char *p)
+char *
+djgpp_pathexp (const char *p)
{
static char expp[PATH_MAX];
strcpy (expp,perlprefix);
strcpy (perlprefix,"..");
}
+int
+djgpp_fflush (FILE *fp)
+{
+ int res;
+
+ if ((res = fflush(fp)) == 0 && fp) {
+ Stat_t s;
+ if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
+ res = fsync(fileno(fp));
+ }
+/*
+ * If the flush succeeded but set end-of-file, we need to clear
+ * the error because our caller may check ferror(). BTW, this
+ * probably means we just flushed an empty file.
+ */
+ if (res == 0 && fp && ferror(fp) == EOF) clearerr(fp);
+
+ return res;
+}
+
+int djgpp_get_stream_mode(FILE *f)
+{
+ extern char *__file_handle_modes;
+
+ int mode = __file_handle_modes[fileno(f)];
+ if (f->_flag & _IORW)
+ return mode | O_RDWR;
+ if (f->_flag & _IOWRT)
+ return mode | O_WRONLY;
+ return mode | O_RDONLY;
+}
+