summaryrefslogtreecommitdiff
path: root/doio.c
diff options
context:
space:
mode:
authorIlya Zakharevich <ilya@math.berkeley.edu>1999-06-16 20:39:34 -0400
committerGurusamy Sarathy <gsar@cpan.org>1999-07-27 06:30:09 +0000
commit6170680bfd1817febf6b13f65734e3e2e6e3f9bf (patch)
tree87a68c7db652aef9bf5d18ececb42a5ef889680e /doio.c
parent31e5645579ece4c41b72ec55a303b796b7409118 (diff)
downloadperl-6170680bfd1817febf6b13f65734e3e2e6e3f9bf.tar.gz
applied suggested patch; added missing prototype changes to
opcode.pl along with documentation typos (feature still needs to be described in perlopentut.pod and summarized in perldelta.pod) Message-Id: <199906170439.AAA18154@monk.mps.ohio-state.edu> Subject: [PATCH 5.00557] 3-arg open p4raw-id: //depot/perl@3786
Diffstat (limited to 'doio.c')
-rw-r--r--doio.c113
1 files changed, 80 insertions, 33 deletions
diff --git a/doio.c b/doio.c
index 880997c887..32c3a04165 100644
--- a/doio.c
+++ b/doio.c
@@ -87,7 +87,17 @@
#endif
bool
-Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp)
+Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+ int rawmode, int rawperm, PerlIO *supplied_fp)
+{
+ return do_open9(gv, name, len, as_raw, rawmode, rawperm,
+ supplied_fp, Nullsv, 0);
+}
+
+bool
+Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+ int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
+ I32 num_svs)
{
register IO *io = GvIOn(gv);
PerlIO *saveifp = Nullfp;
@@ -116,7 +126,7 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
else if (IoIFP(io) != IoOFP(io)) {
if (IoOFP(io)) {
result = PerlIO_close(IoOFP(io));
- PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
+ PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
}
else
result = PerlIO_close(IoIFP(io));
@@ -124,8 +134,9 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
else
result = PerlIO_close(IoIFP(io));
if (result == EOF && fd > PL_maxsysfd)
- PerlIO_printf(PerlIO_stderr(), "Warning: unable to close filehandle %s properly.\n",
- GvENAME(gv));
+ PerlIO_printf(PerlIO_stderr(),
+ "Warning: unable to close filehandle %s properly.\n",
+ GvENAME(gv));
IoOFP(io) = IoIFP(io) = Nullfp;
}
@@ -173,26 +184,44 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
}
else {
char *myname;
+ char *type = name;
+ char *otype = name;
+ STRLEN tlen;
+ STRLEN otlen = len;
char mode[3]; /* stdio file mode ("r\0" or "r+\0") */
int dodup;
+ if (num_svs) {
+ type = name;
+ name = SvPV(svs, tlen) ;
+ len = (I32)tlen;
+ }
+
+ tlen = otlen;
myname = savepvn(name, len);
SAVEFREEPV(myname);
name = myname;
- while (len && isSPACE(name[len-1]))
- name[--len] = '\0';
+ if (!num_svs)
+ while (tlen && isSPACE(type[tlen-1]))
+ type[--tlen] = '\0';
mode[0] = mode[1] = mode[2] = '\0';
- IoTYPE(io) = *name;
- if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */
- mode[1] = *name++;
- --len;
+ IoTYPE(io) = *type;
+ if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */
+ mode[1] = *type++;
+ --tlen;
writing = 1;
}
- if (*name == '|') {
+ if (*type == '|') {
+ if (num_svs && (tlen != 2 || type[1] != '-')) {
+ unknown_desr:
+ Perl_croak(aTHX_ "Unknown open() mode '%.*s'", otlen, otype);
+ }
/*SUPPRESS 530*/
- for (name++; isSPACE(*name); name++) ;
+ for (type++; isSPACE(*type); type++) ;
+ if (!num_svs)
+ name = type;
if (*name == '\0') { /* command is missing 19990114 */
dTHR;
if (ckWARN(WARN_PIPE))
@@ -200,7 +229,7 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
errno = EPIPE;
goto say_false;
}
- if (strNE(name,"-"))
+ if (strNE(name,"-") || num_svs)
TAINT_ENV();
TAINT_PROPER("piped open");
if (name[strlen(name)-1] == '|') {
@@ -212,18 +241,22 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
fp = PerlProc_popen(name,"w");
writing = 1;
}
- else if (*name == '>') {
+ else if (*type == '>') {
TAINT_PROPER("open");
- name++;
- if (*name == '>') {
+ type++;
+ if (*type == '>') {
mode[0] = IoTYPE(io) = 'a';
- name++;
+ type++;
+ tlen--;
}
else
mode[0] = 'w';
writing = 1;
- if (*name == '&') {
+ if (num_svs && tlen != 1)
+ goto unknown_desr;
+ if (*type == '&') {
+ name = type;
duplicity:
dodup = 1;
name++;
@@ -268,35 +301,46 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
}
else {
/*SUPPRESS 530*/
- for (; isSPACE(*name); name++) ;
- if (strEQ(name,"-")) {
+ for (; isSPACE(*type); type++) ;
+ if (strEQ(type,"-")) {
fp = PerlIO_stdout();
IoTYPE(io) = '-';
}
else {
- fp = PerlIO_open(name,mode);
+ fp = PerlIO_open((num_svs ? name : type), mode);
}
}
}
- else if (*name == '<') {
+ else if (*type == '<') {
+ if (num_svs && tlen != 1)
+ goto unknown_desr;
/*SUPPRESS 530*/
- for (name++; isSPACE(*name); name++) ;
+ for (type++; isSPACE(*type); type++) ;
mode[0] = 'r';
- if (*name == '&')
+ if (*type == '&') {
+ name = type;
goto duplicity;
- if (strEQ(name,"-")) {
+ }
+ if (strEQ(type,"-")) {
fp = PerlIO_stdin();
IoTYPE(io) = '-';
}
else
- fp = PerlIO_open(name,mode);
+ fp = PerlIO_open((num_svs ? name : type), mode);
}
- else if (len > 1 && name[len-1] == '|') {
- name[--len] = '\0';
- while (len && isSPACE(name[len-1]))
- name[--len] = '\0';
- /*SUPPRESS 530*/
- for (; isSPACE(*name); name++) ;
+ else if (tlen > 1 && type[tlen-1] == '|') {
+ if (num_svs) {
+ if (tlen != 2 || type[0] != '-')
+ goto unknown_desr;
+ }
+ else {
+ type[--tlen] = '\0';
+ while (tlen && isSPACE(type[tlen-1]))
+ type[--tlen] = '\0';
+ /*SUPPRESS 530*/
+ for (; isSPACE(*type); type++) ;
+ name = type;
+ }
if (*name == '\0') { /* command is missing 19990114 */
dTHR;
if (ckWARN(WARN_PIPE))
@@ -304,13 +348,16 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode
errno = EPIPE;
goto say_false;
}
- if (strNE(name,"-"))
+ if (strNE(name,"-") || num_svs)
TAINT_ENV();
TAINT_PROPER("piped open");
fp = PerlProc_popen(name,"r");
IoTYPE(io) = '|';
}
else {
+ if (num_svs)
+ goto unknown_desr;
+ name = type;
IoTYPE(io) = '<';
/*SUPPRESS 530*/
for (; isSPACE(*name); name++) ;