-#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"
-
-#if DJGPP==2 && DJGPP_MINOR<2
-
-/* XXX I should rewrite this stuff someday. ML */
-
-/* This is from popen.c */
-
-/* Copyright (C) 1997 DJ Delorie, see COPYING.DJ for details */
-/* Copyright (C) 1996 DJ Delorie, see COPYING.DJ for details */
-/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
-
-/* hold file pointer, descriptor, command, mode, temporary file name,
- and the status of the command */
+#define PERLIO_NOT_STDIO 0
+#include "djgpp.h"
+
+/* hold file pointer, command, mode, and the status of the command */
struct pipe_list {
FILE *fp;
- int fd;
int exit_status;
- char *command, mode[10], temp_name[L_tmpnam];
struct pipe_list *next;
+ char *command, mode;
};
/* static, global list pointer */
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;
+ char *temp_name=NULL;
/* make new node */
- if ((l1 = (struct pipe_list *) malloc (sizeof (struct pipe_list))) == NULL)
- return NULL;
-
- /* zero out elements to we'll get here */
- l1->fp = NULL;
- l1->next = pl;
- pl = l1;
-
- /* stick in elements we know already */
- l1->exit_status = -1;
- strcpy (l1->mode, md);
- if (tmpnam (l1->temp_name) == NULL)
- return NULL;
-
- /* if can save the program name, build temp file */
- if ((l1->command = malloc(strlen(cm)+1)))
+ if ((l1 = (struct pipe_list *) malloc (sizeof (*l1)))
+ && (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
{
- strcpy(l1->command, cm);
+ l1->fp = NULL;
+ l1->command = NULL;
+ l1->next = pl;
+ l1->exit_status = -1;
+ l1->mode = md[0];
+
/* if caller wants to read */
- if (l1->mode[0] == 'r')
+ if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
{
- /* dup stdout */
- if ((l1->fd = dup (fileno (stdout))) == EOF)
- l1->fp = NULL;
- else if (!(l1->fp = freopen (l1->temp_name, "wb", stdout)))
- l1->fp = NULL;
- else
- /* exec cmd */
+ if ((l1->fp = freopen (temp_name, "wb", stdout)))
{
- if ((l1->exit_status = system (cm)) == EOF)
- l1->fp = NULL;
+ l1->exit_status = system (cm);
+ if (dup2 (fd, fileno (stdout)) >= 0)
+ l1->fp = fopen (temp_name, md);
}
- /* reopen real stdout */
- if (dup2 (l1->fd, fileno (stdout)) == EOF)
- l1->fp = NULL;
- else
- /* open file for reader */
- l1->fp = fopen (l1->temp_name, l1->mode);
- close(l1->fd);
+ close (fd);
}
- else
- /* if caller wants to write */
- if (l1->mode[0] == 'w')
- /* open temp file */
- l1->fp = fopen (l1->temp_name, l1->mode);
- else
- /* unknown mode */
- l1->fp = NULL;
+ /* if caller wants to write */
+ else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
+ {
+ strcpy (l1->command, cm);
+ l1->fp = fopen (temp_name, md);
+ }
+
+ if (l1->fp)
+ {
+ l1->fp->_flag |= _IORMONCL; /* remove on close */
+ l1->fp->_name_to_remove = temp_name;
+ return (pl = l1)->fp;
+ }
+ free (l1->command);
}
- return l1->fp; /* return == NULL ? ERROR : OK */
+ free (temp_name);
+ free (l1);
+ return NULL;
}
int
-pclose (FILE *pp)
+djgpp_pclose (FILE *pp)
{
- struct pipe_list *l1, *l2; /* list pointers */
- int retval=0; /* function return value */
+ struct pipe_list *l1, **l2; /* list pointers */
+ int retval=-1; /* function return value */
- /* if pointer is first node */
- if (pl->fp == pp)
- {
- /* save node and take it out the list */
- l1 = pl;
- pl = l1->next;
- }
- else
- /* if more than one node in list */
- if (pl->next)
- {
- /* find right node */
- for (l2 = pl, l1 = pl->next; l1; l2 = l1, l1 = l2->next)
- if (l1->fp == pp)
- break;
-
- /* take node out of list */
- l2->next = l1->next;
- }
- else
- return -1;
+ for (l2 = &pl; *l2 && (*l2)->fp != pp; l2 = &((*l2)->next))
+ ;
+ if (!(l1 = *l2))
+ return retval;
+ *l2 = l1->next;
- /* if FILE not in list - return error */
- if (l1->fp == pp)
+ /* if pipe was opened to write */
+ if (l1->mode == 'w')
{
- /* close the (hopefully) popen()ed file */
- fclose (l1->fp);
+ int fd;
+ fflush (l1->fp);
+ close (fileno (l1->fp));
- /* if pipe was opened to write */
- if (l1->mode[0] == 'w')
+ if ((fd = dup (fileno (stdin))) >= 0
+ && (freopen (l1->fp->_name_to_remove, "rb", stdin)))
{
- /* dup stdin */
- if ((l1->fd = dup (fileno (stdin))) == EOF)
- retval = -1;
- else
- /* open temp stdin */
- if (!(l1->fp = freopen (l1->temp_name, "rb", stdin)))
- retval = -1;
- else
- /* exec cmd */
- if ((retval = system (l1->command)) != EOF)
- {
- /* reopen stdin */
- if (dup2 (l1->fd, fileno (stdin)) == EOF)
- retval = -1;
- }
- close(l1->fd);
+ retval = system (l1->command);
+ dup2 (fd, fileno (stdin));
}
- else
- /* if pipe was opened to read, return the exit status we saved */
- if (l1->mode[0] == 'r')
- retval = l1->exit_status;
- else
- /* invalid mode */
- retval = -1;
+ close (fd);
+ free (l1->command);
}
- remove (l1->temp_name); /* remove temporary file */
- free (l1->command); /* dealloc memory */
- free (l1); /* dealloc memory */
+ else
+ /* if pipe was opened to read, return the exit status we saved */
+ retval = l1->exit_status;
- return retval; /* retval==0 ? OK : ERROR */
+ fclose (l1->fp); /* this removes the temp file */
+ free (l1);
+ return retval; /* retval==0 ? OK : ERROR */
}
-#endif
-
/**/
#define EXECF_SPAWN 0
#define EXECF_EXEC 1
static int
-convretcode (int rc,char *prog,int fl)
+convretcode (pTHX_ int rc,char *prog,int fl)
{
- if (rc < 0 && dowarn)
- warn ("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 && ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s",
+ fl ? "exec" : "spawn",prog,Strerror (errno));
+ if (rc >= 0)
+ return rc << 8;
+ return -1;
}
int
-do_aspawn (SV *really,SV **mark,SV **sp)
+do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
{
- dTHR;
int rc;
char **a,*tmps,**argv;
+ STRLEN n_a;
if (sp<=mark)
return -1;
while (++mark <= sp)
if (*mark)
- *a++ = SvPVx(*mark, na);
+ *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
- *a = Nullch;
+ *a = NULL;
if (argv[0][0] != '/' && argv[0][0] != '\\'
&& !(argv[0][0] && argv[0][1] == ':'
) /* will swawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
- if (really && *(tmps = SvPV(really, na)))
+ if (really && *(tmps = SvPV(really, n_a)))
rc=spawnvp (P_WAIT,tmps,argv);
else
rc=spawnvp (P_WAIT,argv[0],argv);
#define EXTRA "\x00\x00\x00\x00\x00\x00"
int
-do_spawn2 (char *cmd,int execf)
+do_spawn2 (pTHX_ char *cmd,int execf)
{
char **a,*s,*shell,*metachars;
int rc,unixysh;
return convretcode (system (cmd),cmd,execf);
}
- New (1303,Argv,(s-cmd)/2+2,char*);
- Cmd=savepvn (cmd,s-cmd);
- a=Argv;
- for (s=Cmd; *s;) {
+ Newx (PL_Argv,(s-cmd)/2+2,char*);
+ PL_Cmd=savepvn (cmd,s-cmd);
+ a=PL_Argv;
+ for (s=PL_Cmd; *s;) {
while (*s && isSPACE (*s)) s++;
if (*s)
*(a++)=s;
if (*s)
*s++='\0';
}
- *a=Nullch;
- if (!Argv[0])
+ *a=NULL;
+ if (!PL_Argv[0])
return -1;
if (execf==EXECF_EXEC)
- rc=execvp (Argv[0],Argv);
+ rc=execvp (PL_Argv[0],PL_Argv);
else
- rc=spawnvp (P_WAIT,Argv[0],Argv);
- return convretcode (rc,Argv[0],execf);
+ rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
+ return convretcode (rc,PL_Argv[0],execf);
}
int
-do_spawn (char *cmd)
+do_spawn (pTHX_ char *cmd)
{
- return do_spawn2 (cmd,EXECF_SPAWN);
+ return do_spawn2 (aTHX_ cmd,EXECF_SPAWN);
}
bool
-do_exec (char *cmd)
+Perl_do_exec (pTHX_ const char *cmd)
{
- do_spawn2 (cmd,EXECF_EXEC);
+ do_spawn2 (aTHX_ cmd,EXECF_EXEC);
return FALSE;
}
int fd;
char *matches;
size_t size;
+ fpos_t pos;
};
#define MAXOPENGLOBS 10
if ((gi=searchfd (-1)) == NULL)
break;
+ gi->pos=0;
pattern=alloca (strlen (name+=13)+1);
strcpy (pattern,name);
if (!_USE_LFN)
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;
}
dXSARGS;
if (items)
- croak ("Usage: Dos::GetCwd()");
+ Perl_croak (aTHX_ "Usage: Dos::GetCwd()");
{
char tmp[PATH_MAX+2];
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
-init_os_extras()
+Perl_init_os_extras(pTHX)
{
char *file = __FILE__;
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;
+}
+
https://perl5.git.perl.org / perl5.git / blobdiff