X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=djgpp%2Fdjgpp.c;h=d770cefb969b6f5cbf7c797afecdec1e439d6edc;hb=157b749675929e393a7c0bb5f4006743737e22f3;hp=80a627e518cc845a215ba960cd9195807a64038f;hpb=22d4bb9ccb8701e68f9243547d7e3a3c55f70908;p=p5sagit%2Fp5-mst-13.2.git diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 80a627e..d770cef 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 */ @@ -120,7 +106,7 @@ 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; @@ -130,7 +116,6 @@ convretcode (pTHX_ int rc,char *prog,int fl) int do_aspawn (pTHX_ SV *really,SV **mark,SV **sp) { - dTHR; int rc; char **a,*tmps,**argv; STRLEN n_a; @@ -367,6 +352,9 @@ XS(dos_GetCwd) 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); } @@ -378,6 +366,24 @@ 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 Perl_init_os_extras(pTHX) { @@ -387,6 +393,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); @@ -397,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); @@ -452,3 +460,16 @@ djgpp_fflush (FILE *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; +} +