X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9731c6ca89275fa6ca122bfe3be4600e5836a905..271c8bde9d592c5e6bb98307158488ea8f751037:/djgpp/djgpp.c diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 466b4ab..9370a29 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -1,19 +1,5 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#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 */ @@ -117,23 +103,22 @@ pclose (FILE *pp) #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; @@ -141,10 +126,10 @@ do_aspawn (SV *really,SV **mark,SV **sp) 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] == ':' @@ -152,7 +137,7 @@ do_aspawn (SV *really,SV **mark,SV **sp) ) /* 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); @@ -163,7 +148,7 @@ do_aspawn (SV *really,SV **mark,SV **sp) #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; @@ -208,10 +193,10 @@ doshell: 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; @@ -219,27 +204,27 @@ doshell: 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; } @@ -250,6 +235,7 @@ struct globinfo int fd; char *matches; size_t size; + fpos_t pos; }; #define MAXOPENGLOBS 10 @@ -284,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) @@ -330,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; } @@ -360,12 +346,15 @@ XS(dos_GetCwd) 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); } @@ -377,8 +366,26 @@ 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); +#ifndef INCOMPLETE_TAINTS + SvTAINTED_on(ST(0)); +#endif + } + XSRETURN(1); +} + void -init_os_extras() +Perl_init_os_extras(pTHX) { char *file = __FILE__; @@ -386,6 +393,7 @@ init_os_extras() 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); @@ -396,7 +404,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); @@ -432,3 +441,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; +} +