From: Nick Ing-Simmons Date: Sat, 18 Nov 2000 14:06:20 +0000 (+0000) Subject: Basic tweaks to do_open() type parsing to allow layer/discipline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b931b1d952313afa398828ff4b2a40af20cfa65a;p=p5sagit%2Fp5-mst-13.2.git Basic tweaks to do_open() type parsing to allow layer/discipline part to be isolated. p4raw-id: //depot/perlio@7736 --- diff --git a/doio.c b/doio.c index 05ace5e..84a647f 100644 --- a/doio.c +++ b/doio.c @@ -79,9 +79,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int result; bool was_fdopen = FALSE; bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0; + char *type = NULL; + char *deftype = NULL; + char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ + Zero(mode,sizeof(mode),char); PL_forkprocess = 1; /* assume true if no fork */ + /* Collect default raw/crlf info from the op */ if (PL_op && PL_op->op_type == OP_OPEN) { /* set up disciplines */ U8 flags = PL_op->op_private; @@ -91,6 +96,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, out_crlf = (flags & OPpOPEN_OUT_CRLF); } + /* If currently open - close before we re-open */ if (IoIFP(io)) { fd = PerlIO_fileno(IoIFP(io)); if (IoTYPE(io) == IoTYPE_STD) @@ -121,6 +127,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } if (as_raw) { + /* sysopen style args, i.e. integer mode and permissions */ + #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE) rawmode |= O_LARGEFILE; #endif @@ -148,75 +156,79 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (fd == -1) fp = NULL; else { - char fpmode[4]; STRLEN ix = 0; - if (result == O_RDONLY) - fpmode[ix++] = 'r'; + if (result == O_RDONLY) { + mode[ix++] = 'r'; + } #ifdef O_APPEND else if (rawmode & O_APPEND) { - fpmode[ix++] = 'a'; + mode[ix++] = 'a'; if (result != O_WRONLY) - fpmode[ix++] = '+'; + mode[ix++] = '+'; } #endif else { if (result == O_WRONLY) - fpmode[ix++] = 'w'; + mode[ix++] = 'w'; else { - fpmode[ix++] = 'r'; - fpmode[ix++] = '+'; + mode[ix++] = 'r'; + mode[ix++] = '+'; } } if (rawmode & O_BINARY) - fpmode[ix++] = 'b'; - fpmode[ix] = '\0'; - fp = PerlIO_fdopen(fd, fpmode); + mode[ix++] = 'b'; + mode[ix] = '\0'; + fp = PerlIO_fdopen(fd, mode); if (!fp) PerlLIO_close(fd); } } else { - char *type; + /* Regular (non-sys) open */ char *oname = name; - STRLEN tlen; STRLEN olen = len; - char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ - int dodup; + char *tend; + int dodup = 0; type = savepvn(name, len); - tlen = len; + tend = type+len; SAVEFREEPV(type); + /* Loose trailing white space */ + while (tend > type && isSPACE(tend[-1])) + *tend-- = '\0'; if (num_svs) { + /* New style explict name, type is just mode and discipline/layer info */ STRLEN l; name = SvPV(svs, l) ; len = (I32)l; name = savepvn(name, len); SAVEFREEPV(name); + /*SUPPRESS 530*/ + for (; isSPACE(*type); type++) ; } else { - while (tlen && isSPACE(type[tlen-1])) - type[--tlen] = '\0'; name = type; - len = tlen; + len = tend-type; } - mode[0] = mode[1] = mode[2] = mode[3] = '\0'; IoTYPE(io) = *type; - if (*type == IoTYPE_RDWR && tlen > 1 && type[tlen-1] != IoTYPE_PIPE) { /* scary */ + if (*type == IoTYPE_RDWR && (!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE)) { /* scary */ mode[1] = *type++; - --tlen; writing = 1; } if (*type == IoTYPE_PIPE) { - if (num_svs && (tlen != 2 || type[1] != IoTYPE_STD)) { - unknown_desr: - Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname); + if (num_svs) { + if (type[1] != IoTYPE_STD) { + unknown_desr: + Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname); + } + type++; } /*SUPPRESS 530*/ - for (type++, tlen--; isSPACE(*type); type++, tlen--) ; + for (type++; isSPACE(*type); type++) ; if (!num_svs) { name = type; - len = tlen; + len = tend-type; } if (*name == '\0') { /* command is missing 19990114 */ dTHR; @@ -228,7 +240,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (strNE(name,"-") || num_svs) TAINT_ENV(); TAINT_PROPER("piped open"); - if (name[len-1] == '|') { + if (!num_svs && name[len-1] == '|') { dTHR; name[--len] = '\0' ; if (ckWARN(WARN_PIPE)) @@ -249,7 +261,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, /* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */ mode[0] = IoTYPE(io) = IoTYPE_APPEND; type++; - tlen--; } else mode[0] = 'w'; @@ -260,11 +271,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, else if (out_crlf) strcat(mode, "t"); - if (num_svs && tlen != 1) - goto unknown_desr; if (*type == '&') { name = type; duplicity: + if (num_svs) + goto unknown_desr; dodup = 1; name++; if (*name == '=') { @@ -336,7 +347,9 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, else { /*SUPPRESS 530*/ for (; isSPACE(*type); type++) ; - if (*type == IoTYPE_STD && !type[1]) { + if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) { + /*SUPPRESS 530*/ + type++; fp = PerlIO_stdout(); IoTYPE(io) = IoTYPE_STD; } @@ -346,8 +359,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } else if (*type == IoTYPE_RDONLY) { - if (num_svs && tlen != 1) - goto unknown_desr; /*SUPPRESS 530*/ for (type++; isSPACE(*type); type++) ; mode[0] = 'r'; @@ -360,25 +371,28 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, name = type; goto duplicity; } - if (*type == IoTYPE_STD && !type[1]) { + if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) { + /*SUPPRESS 530*/ + type++; fp = PerlIO_stdin(); IoTYPE(io) = IoTYPE_STD; } else fp = PerlIO_open((num_svs ? name : type), mode); } - else if (tlen > 1 && type[tlen-1] == IoTYPE_PIPE) { + else if ((num_svs && type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) || + (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) { if (num_svs) { - if (tlen != 2 || type[0] != IoTYPE_STD) - goto unknown_desr; + type += 2; /* skip over '-|' */ } else { - type[--tlen] = '\0'; - while (tlen && isSPACE(type[tlen-1])) - type[--tlen] = '\0'; + *--tend = '\0'; + while (tend > type && isSPACE(tend[-1])) + *--tend = '\0'; /*SUPPRESS 530*/ for (; isSPACE(*type); type++) ; name = type; + len = tend-type; } if (*name == '\0') { /* command is missing 19990114 */ dTHR; @@ -494,20 +508,23 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } #endif IoIFP(io) = fp; + if (!num_svs) { + /* Need to supply default type info from open.pm */ + type = NULL; + } + if (type) { + while (isSPACE(*type)) type++; + if (*type) { + } + } + IoFLAGS(io) &= ~IOf_NOLINE; if (writing) { dTHR; if (IoTYPE(io) == IoTYPE_SOCKET || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) { - char *mode; - if (out_raw) - mode = "wb"; - else if (out_crlf) - mode = "wt"; - else - mode = "w"; - + mode[0] = 'w'; if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) { PerlIO_close(fp); IoIFP(io) = Nullfp; diff --git a/perlio.c b/perlio.c index 05f589a..0ca7a7a 100644 --- a/perlio.c +++ b/perlio.c @@ -208,30 +208,10 @@ PerlIO_pop(PerlIO *f) } } -#undef PerlIO_close -int -PerlIO_close(PerlIO *f) -{ - int code = (*PerlIOBase(f)->tab->Close)(f); - while (*f) - { - PerlIO_pop(f); - } - return code; -} - - /*--------------------------------------------------------------------------------------*/ -/* Given the abstraction above the public API functions */ +/* XS Interface for perl code */ -#undef PerlIO_fileno -int -PerlIO_fileno(PerlIO *f) -{ - return (*PerlIOBase(f)->tab->Fileno)(f); -} - -XS(XS_io_import) +XS(XS_perlio_import) { dXSARGS; GV *gv = CvGV(cv); @@ -241,7 +221,7 @@ XS(XS_io_import) XSRETURN_EMPTY; } -XS(XS_io_unimport) +XS(XS_perlio_unimport) { dXSARGS; GV *gv = CvGV(cv); @@ -271,7 +251,7 @@ perlio_mg_set(pTHX_ SV *sv, MAGIC *mg) { if (SvROK(sv)) { - IO *io = GvIOn(SvRV(sv)); + IO *io = GvIOn((GV *)SvRV(sv)); PerlIO *ifp = IoIFP(io); PerlIO *ofp = IoOFP(io); AV *av = (AV *) mg->mg_obj; @@ -285,7 +265,7 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg) { if (SvROK(sv)) { - IO *io = GvIOn(SvRV(sv)); + IO *io = GvIOn((GV *)SvRV(sv)); PerlIO *ifp = IoIFP(io); PerlIO *ofp = IoOFP(io); AV *av = (AV *) mg->mg_obj; @@ -353,7 +333,7 @@ void PerlIO_define_layer(PerlIO_funcs *tab) { dTHX; - HV *stash = gv_stashpv("io::Layer", TRUE); + HV *stash = gv_stashpv("perlio::Layer", TRUE); SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash); hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0); } @@ -369,11 +349,13 @@ PerlIO_default_layer(I32 n) if (!PerlIO_layer_hv) { char *s = PerlEnv_getenv("PERLIO"); - newXS("io::import",XS_io_import,__FILE__); - newXS("io::unimport",XS_io_unimport,__FILE__); + newXS("perlio::import",XS_perlio_import,__FILE__); + newXS("perlio::unimport",XS_perlio_unimport,__FILE__); +#if 0 newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__); - PerlIO_layer_hv = get_hv("io::layers",GV_ADD|GV_ADDMULTI); - PerlIO_layer_av = get_av("io::layers",GV_ADD|GV_ADDMULTI); +#endif + PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI); + PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI); PerlIO_define_layer(&PerlIO_unix); PerlIO_define_layer(&PerlIO_perlio); PerlIO_define_layer(&PerlIO_stdio); @@ -465,6 +447,30 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode) return f; } +/*--------------------------------------------------------------------------------------*/ +/* Given the abstraction above the public API functions */ + +#undef PerlIO_close +int +PerlIO_close(PerlIO *f) +{ + int code = (*PerlIOBase(f)->tab->Close)(f); + while (*f) + { + PerlIO_pop(f); + } + return code; +} + +#undef PerlIO_fileno +int +PerlIO_fileno(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Fileno)(f); +} + + + #undef PerlIO_fdopen PerlIO * PerlIO_fdopen(int fd, const char *mode)