X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0453d815b8a74697ff1e5451c27aba2fe537b8e0..730480ce9e3e0103efa8f551281a62b39f573b1a:/djgpp/djgpp.c

diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c
index 5c1d3c4..6d136e3 100644
--- a/djgpp/djgpp.c
+++ b/djgpp/djgpp.c
@@ -1,19 +1,5 @@
-#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 {
@@ -27,7 +13,7 @@ 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;
@@ -75,7 +61,7 @@ popen (const char *cm, const char *md) /* program name, pipe mode */
 }
 
 int
-pclose (FILE *pp)
+djgpp_pclose (FILE *pp)
 {
   struct pipe_list *l1, **l2;   /* list pointers */
   int retval=-1;		/* function return value */
@@ -120,19 +106,16 @@ static int
 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)
-        return rc <<= 8;
-    if (rc < 0)
-        return 255 << 8;
-    return 0;
+    if (rc >= 0)
+        return rc << 8;
+    return -1;
 }
 
 int
 do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
 {
-    dTHR;
     int  rc;
     char **a,*tmps,**argv; 
     STRLEN n_a;
@@ -146,7 +129,7 @@ do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
             *a++ = SvPVx(*mark, n_a);
         else
             *a++ = "";
-    *a = Nullch;
+    *a = NULL;
 
     if (argv[0][0] != '/' && argv[0][0] != '\\'
         && !(argv[0][0] && argv[0][1] == ':'
@@ -210,7 +193,7 @@ doshell:
             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;) {
@@ -221,7 +204,7 @@ doshell:
 	if (*s)
 	    *s++='\0';
     }
-    *a=Nullch;
+    *a=NULL;
     if (!PL_Argv[0])
         return -1;
 
@@ -239,7 +222,7 @@ do_spawn (pTHX_ char *cmd)
 }
 
 bool
-Perl_do_exec (pTHX_ char *cmd)
+Perl_do_exec (pTHX_ const char *cmd)
 {
     do_spawn2 (aTHX_ cmd,EXECF_EXEC);
     return FALSE;
@@ -252,6 +235,7 @@ struct globinfo
     int    fd;
     char   *matches;
     size_t size;
+    fpos_t pos;
 };
 
 #define MAXOPENGLOBS 10
@@ -286,6 +270,7 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
             if ((gi=searchfd (-1)) == NULL)
                 break;
 
+            gi->pos=0;
             pattern=alloca (strlen (name+=13)+1);
             strcpy (pattern,name);
             if (!_USE_LFN)
@@ -332,11 +317,10 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
             if ((gi=searchfd (fd))==NULL)
                 break;
 
-            ic=tell (fd);
-            if (siz+ic>=gi->size)
-                siz=gi->size-ic;
-            memcpy (buf,ic+gi->matches,siz);
-            lseek (fd,siz,1);
+            if (siz+gi->pos > gi->size)
+                siz = gi->size - gi->pos;
+            memcpy (buf,gi->pos+gi->matches,siz);
+            gi->pos += siz;
             *rv=siz;
             return 1;
         }
@@ -368,6 +352,7 @@ XS(dos_GetCwd)
         ST(0)=sv_newmortal ();
         if (getcwd (tmp,PATH_MAX+1)!=NULL)
             sv_setpv ((SV*)ST(0),tmp);
+	SvTAINTED_on(ST(0));
     }
     XSRETURN (1);
 }
@@ -379,6 +364,22 @@ XS(dos_UseLFN)
     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);
+	SvTAINTED_on(ST(0));
+    }
+    XSRETURN(1);
+}
+
 void
 Perl_init_os_extras(pTHX)
 {
@@ -388,6 +389,7 @@ 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);
@@ -398,7 +400,8 @@ static char *perlprefix;
 
 #define PERL5 "/perl5"
 
-char *djgpp_pathexp (const char *p)
+char *
+djgpp_pathexp (const char *p)
 {
     static char expp[PATH_MAX];
     strcpy (expp,perlprefix);
@@ -434,3 +437,35 @@ Perl_DJGPP_init (int *argcp,char ***argvp)
         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;
+}
+