diff options
| -rw-r--r-- | doio.c | 113 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 3 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | opcode.h | 2 | ||||
| -rwxr-xr-x | opcode.pl | 2 | ||||
| -rwxr-xr-x | perlapi.c | 7 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 91 | ||||
| -rw-r--r-- | pp_sys.c | 10 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rwxr-xr-x | t/comp/proto.t | 2 | ||||
| -rwxr-xr-x | t/io/open.t | 78 |
14 files changed, 264 insertions, 60 deletions
@@ -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++) ; @@ -122,6 +122,7 @@ #define do_join Perl_do_join #define do_kv Perl_do_kv #define do_open Perl_do_open +#define do_open9 Perl_do_open9 #define do_pipe Perl_do_pipe #define do_print Perl_do_print #define do_readline Perl_do_readline @@ -1447,6 +1448,7 @@ #define do_join(a,b,c,d) Perl_do_join(aTHX_ a,b,c,d) #define do_kv() Perl_do_kv(aTHX) #define do_open(a,b,c,d,e,f,g) Perl_do_open(aTHX_ a,b,c,d,e,f,g) +#define do_open9(a,b,c,d,e,f,g,h,i) Perl_do_open9(aTHX_ a,b,c,d,e,f,g,h,i) #define do_pipe(a,b,c) Perl_do_pipe(aTHX_ a,b,c) #define do_print(a,b) Perl_do_print(aTHX_ a,b) #define do_readline() Perl_do_readline(aTHX) @@ -2875,6 +2877,8 @@ #define do_kv Perl_do_kv #define Perl_do_open CPerlObj::Perl_do_open #define do_open Perl_do_open +#define Perl_do_open9 CPerlObj::Perl_do_open9 +#define do_open9 Perl_do_open9 #define Perl_do_pipe CPerlObj::Perl_do_pipe #define do_pipe Perl_do_pipe #define Perl_do_print CPerlObj::Perl_do_print @@ -1102,6 +1102,9 @@ p |void |do_join |SV* sv|SV* del|SV** mark|SV** sp p |OP* |do_kv p |bool |do_open |GV* gv|char* name|I32 len|int as_raw \ |int rawmode|int rawperm|PerlIO* supplied_fp +p |bool |do_open9 |GV *gv|char *name|I32 len|int as_raw \ + |int rawmode|int rawperm|PerlIO *supplied_fp \ + |SV *svs|I32 num p |void |do_pipe |SV* sv|GV* rgv|GV* wgv p |bool |do_print |SV* sv|PerlIO* fp p |OP* |do_readline diff --git a/global.sym b/global.sym index fa2885409e..3b034e8290 100644 --- a/global.sym +++ b/global.sym @@ -102,6 +102,7 @@ Perl_do_shmio Perl_do_join Perl_do_kv Perl_do_open +Perl_do_open9 Perl_do_pipe Perl_do_print Perl_do_readline @@ -1215,6 +1215,10 @@ #define Perl_do_open pPerl->Perl_do_open #undef do_open #define do_open Perl_do_open +#undef Perl_do_open9 +#define Perl_do_open9 pPerl->Perl_do_open9 +#undef do_open9 +#define do_open9 Perl_do_open9 #undef Perl_do_pipe #define Perl_do_pipe pPerl->Perl_do_pipe #undef do_pipe @@ -1994,7 +1994,7 @@ EXT U32 PL_opargs[] = { 0x00001a44, /* dump */ 0x00001a44, /* goto */ 0x00013644, /* exit */ - 0x0012c81c, /* open */ + 0x0132c81c, /* open */ 0x0001d614, /* close */ 0x000cc814, /* pipe_op */ 0x0000d61c, /* fileno */ @@ -568,7 +568,7 @@ exit exit ck_fun ds% S? # I/O. -open open ck_fun ist@ F S? +open open ck_fun ist@ F S? S? close close ck_fun is% F? pipe_op pipe ck_fun is@ F F @@ -798,6 +798,13 @@ Perl_do_open(pTHXo_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int ra return ((CPerlObj*)pPerl)->Perl_do_open(gv, name, len, as_raw, rawmode, rawperm, supplied_fp); } +#undef Perl_do_open9 +bool +Perl_do_open9(pTHXo_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num) +{ + return ((CPerlObj*)pPerl)->Perl_do_open9(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, svs, num); +} + #undef Perl_do_pipe void Perl_do_pipe(pTHXo_ SV* sv, GV* rgv, GV* wgv) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index e86bfbffbb..646355fe81 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2890,6 +2890,12 @@ representative, who probably put it there in the first place. (F) There are no byte-swapping functions for a machine with this byte order. +=item Unknown open() mode '%s' + +(F) The second argument of 3-arguments open is not one from the list +of C<L<lt>>, C<L<gt>>, C<E<gt>E<gt>>, C<+L<lt>>, C<+L<gt>>, +C<+E<gt>E<gt>>, C<-|>, C<|-> of possible open() modes. + =item Unknown process %x sent message to prime_env_iter: %s (P) An error peculiar to VMS. Perl was reading values for %ENV before diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index f9d498c19e..2ced382085 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2419,6 +2419,8 @@ to be converted into a file mode, for example. (Although perl will automatically convert strings into numbers as needed, this automatic conversion assumes base 10.) +=item open FILEHANDLE,MODE,EXPR + =item open FILEHANDLE,EXPR =item open FILEHANDLE @@ -2432,9 +2434,9 @@ for this purpose; so if you're using C<my>, specify EXPR in your call to open.) See L<perlopentut> for a kinder, gentler explanation of opening files. -If the filename begins with C<'E<lt>'> or nothing, the file is opened for input. -If the filename begins with C<'E<gt>'>, the file is truncated and opened for -output, being created if necessary. If the filename begins with C<'E<gt>E<gt>'>, +If MODE is C<'E<lt>'> or nothing, the file is opened for input. +If MODE is C<'E<gt>'>, the file is truncated and opened for +output, being created if necessary. If MODE is C<'E<gt>E<gt>'>, the file is opened for appending, again being created if necessary. You can put a C<'+'> in front of the C<'E<gt>'> or C<'E<lt>'> to indicate that you want both read and write access to the file; thus C<'+E<lt>'> is almost @@ -2444,10 +2446,13 @@ textfiles, since they have variable length records. See the B<-i> switch in L<perlrun> for a better approach. The file is created with permissions of C<0666> modified by the process' C<umask> value. -The prefix and the filename may be separated with spaces. These various prefixes correspond to the fopen(3) modes of C<'r'>, C<'r+'>, C<'w'>, C<'w+'>, C<'a'>, and C<'a+'>. +In the 2-arguments (and 1-argument) form of the call the mode and +filename should be concatenated (in this order), possibly separated by +spaces. It is possible to omit the mode if the mode is C<'E<lt>'>. + If the filename begins with C<'|'>, the filename is interpreted as a command to which output is to be piped, and if the filename ends with a C<'|'>, the filename is interpreted as a command which pipes output to @@ -2456,7 +2461,19 @@ for more examples of this. (You are not allowed to C<open> to a command that pipes both in I<and> out, but see L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.) -Opening C<'-'> opens STDIN and opening C<'E<gt>-'> opens STDOUT. Open returns +If MODE is C<'|-'>, the filename is interpreted as a +command to which output is to be piped, and if MODE is +C<'-|'>, the filename is interpreted as a command which pipes output to +us. In the 2-arguments (and 1-argument) form one should replace dash +(C<'-'>) with the command. See L<perlipc/"Using open() for IPC"> +for more examples of this. (You are not allowed to C<open> to a command +that pipes both in I<and> out, but see L<IPC::Open2>, L<IPC::Open3>, +and L<perlipc/"Bidirectional Communication"> for alternatives.) + +In the 2-arguments (and 1-argument) form opening C<'-'> opens STDIN +and opening C<'E<gt>-'> opens STDOUT. + +Open returns nonzero upon success, the undefined value otherwise. If the C<open> involved a pipe, the return value happens to be the pid of the subprocess. @@ -2483,16 +2500,22 @@ Examples: open ARTICLE or die "Can't find article $ARTICLE: $!\n"; while (<ARTICLE>) {... - open(LOG, '>>/usr/spool/news/twitlog'); # (log is reserved) + open(LOG, '>>/usr/spool/news/twitlog'); # (log is reserved) # if the open fails, output is discarded - open(DBASE, '+<dbase.mine') # open for update + open(DBASE, '+<', 'dbase.mine') # open for update or die "Can't open 'dbase.mine' for update: $!"; - open(ARTICLE, "caesar <$article |") # decrypt article + open(DBASE, '+<dbase.mine') # ditto + or die "Can't open 'dbase.mine' for update: $!"; + + open(ARTICLE, '-|', "caesar <$article") # decrypt article or die "Can't start caesar: $!"; - open(EXTRACT, "|sort >/tmp/Tmp$$") # $$ is our process id + open(ARTICLE, "caesar <$article |") # ditto + or die "Can't start caesar: $!"; + + open(EXTRACT, "|sort >/tmp/Tmp$$") # $$ is our process id or die "Can't start sort: $!"; # process argument list of files along with any includes @@ -2522,11 +2545,13 @@ Examples: You may also, in the Bourne shell tradition, specify an EXPR beginning with C<'E<gt>&'>, in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) to be -duped and opened. You may use C<&> after C<E<gt>>, C<E<gt>E<gt>>, C<E<lt>>, C<+E<gt>>, -C<+E<gt>E<gt>>, and C<+E<lt>>. The +duped and opened. You may use C<&> after C<E<gt>>, C<E<gt>E<gt>>, +C<E<lt>>, C<+E<gt>>, C<+E<gt>E<gt>>, and C<+E<lt>>. The mode you specify should match the mode of the original filehandle. (Duping a filehandle does not take into account any existing contents of -stdio buffers.) +stdio buffers.) Duping file handles is not yet supported for 3-argument +open(). + Here is a script that saves, redirects, and restores STDOUT and STDERR: @@ -2534,8 +2559,8 @@ STDERR: open(OLDOUT, ">&STDOUT"); open(OLDERR, ">&STDERR"); - open(STDOUT, ">foo.out") || die "Can't redirect stdout"; - open(STDERR, ">&STDOUT") || die "Can't dup stdout"; + open(STDOUT, '>', "foo.out") || die "Can't redirect stdout"; + open(STDERR, ">&STDOUT") || die "Can't dup stdout"; select(STDERR); $| = 1; # make unbuffered select(STDOUT); $| = 1; # make unbuffered @@ -2558,7 +2583,8 @@ parsimonious of file descriptors. For example: open(FILEHANDLE, "<&=$fd") -If you open a pipe on the command C<'-'>, i.e., either C<'|-'> or C<'-|'>, then +If you open a pipe on the command C<'-'>, i.e., either C<'|-'> or C<'-|'> +with 2-arguments (or 1-argument) form of open(), then there is an implicit fork done, and the return value of open is the pid of the child within the parent process, and C<0> within the child process. (Use C<defined($pid)> to determine whether the open was successful.) @@ -2569,13 +2595,15 @@ the new STDOUT or STDIN. Typically this is used like the normal piped open when you want to exercise more control over just how the pipe command gets executed, such as when you are running setuid, and don't want to have to scan shell commands for metacharacters. -The following pairs are more or less equivalent: +The following triples are more or less equivalent: open(FOO, "|tr '[a-z]' '[A-Z]'"); - open(FOO, "|-") || exec 'tr', '[a-z]', '[A-Z]'; + open(FOO, '|-', "tr '[a-z]' '[A-Z]'"); + open(FOO, '|-') || exec 'tr', '[a-z]', '[A-Z]'; open(FOO, "cat -n '$file'|"); - open(FOO, "-|") || exec 'cat', '-n', $file; + open(FOO, '-|', "cat -n '$file'"); + open(FOO, '-|') || exec 'cat', '-n', $file; See L<perlipc/"Safe Pipe Opens"> for more examples of this. @@ -2587,7 +2615,8 @@ file descriptor as determined by the value of $^F. See L<perlvar/$^F>. Closing any piped filehandle causes the parent process to wait for the child to finish, and returns the status value in C<$?>. -The filename passed to open will have leading and trailing +The filename passed to 2-argument (or 1-argument) form of open() +will have leading and trailing whitespace deleted, and the normal redirection characters honored. This property, known as "magic open", can often be used to good effect. A user could specify a filename of @@ -2596,14 +2625,32 @@ F<"rsh cat file |">, or you could change certain filenames as needed: $filename =~ s/(.*\.gz)\s*$/gzip -dc < $1|/; open(FH, $filename) or die "Can't open $filename: $!"; -However, to open a file with arbitrary weird characters in it, it's -necessary to protect any leading and trailing whitespace: +Use 3-argument form to open a file with arbitrary weird characters in it, + + open(FOO, '<', $file); + +otherwise it's necessary to protect any leading and trailing whitespace: $file =~ s#^(\s)#./$1#; open(FOO, "< $file\0"); +(this may not work on some bizzare filesystems). One should +conscientiously choose between the the I<magic> and 3-arguments form +of open(): + + open IN, $ARGV[0]; + +will allow the user to specify an argument of the form C<"rsh cat file |">, +but will not work on a filename which happens to have a trailing space, while + + open IN, '<', $ARGV[0]; + +will have exactly the opposite restrictions. + If you want a "real" C C<open> (see L<open(2)> on your system), then you -should use the C<sysopen> function, which involves no such magic. This is +should use the C<sysopen> function, which involves no such magic (but +may use subtly different filemodes than Perl open(), which is mapped +to C fopen()). This is another way to protect your filenames from interpretation. For example: use IO::Handle; @@ -501,10 +501,16 @@ PP(pp_open) djSP; dTARGET; GV *gv; SV *sv; + SV *name; + I32 have_name = 0; char *tmps; STRLEN len; MAGIC *mg; + if (MAXARG > 2) { + name = POPs; + have_name = 1; + } if (MAXARG > 1) sv = POPs; if (!isGV(TOPs)) @@ -537,6 +543,8 @@ PP(pp_open) PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); XPUSHs(sv); + if (have_name) + XPUSHs(name); PUTBACK; ENTER; call_method("OPEN", G_SCALAR); @@ -546,7 +554,7 @@ PP(pp_open) } tmps = SvPV(sv, len); - if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp)) + if (do_open9(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, name, have_name)) PUSHi( (I32)PL_forkprocess ); else if (PL_forkprocess == 0) /* we are a new child */ PUSHi(0); @@ -115,6 +115,7 @@ VIRTUAL I32 Perl_do_shmio(pTHX_ I32 optype, SV** mark, SV** sp); VIRTUAL void Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp); VIRTUAL OP* Perl_do_kv(pTHX); VIRTUAL bool Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp); +VIRTUAL bool Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num); VIRTUAL void Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv); VIRTUAL bool Perl_do_print(pTHX_ SV* sv, PerlIO* fp); VIRTUAL OP* Perl_do_readline(pTHX); diff --git a/t/comp/proto.t b/t/comp/proto.t index ecfbec60da..6381facbea 100755 --- a/t/comp/proto.t +++ b/t/comp/proto.t @@ -384,7 +384,7 @@ print "ok ", $i++, "\n"; print "not " if defined prototype('CORE::system'); print "ok ", $i++, "\n"; -print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$'; +print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$;$'; print "ok ", $i++, "\n"; print "# CORE:Foo => ($p), \$@ => `$@'\nnot " diff --git a/t/io/open.t b/t/io/open.t index 63079c8b77..0154b8fc14 100755 --- a/t/io/open.t +++ b/t/io/open.t @@ -4,10 +4,11 @@ $| = 1; $^W = 1; -print "1..9\n"; +print "1..32\n"; # my $file tests +{ unlink("afile") if -f "afile"; print "$!\nnot " unless open(my $f,"+>afile"); print "ok 1\n"; @@ -32,4 +33,79 @@ print "ok 8\n"; print "not " unless close($f); print "ok 9\n"; unlink("afile"); +} +{ +print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); +print "ok 10\n"; +print $f "a row\n"; +print "not " unless close($f); +print "ok 11\n"; +print "not " unless -s 'afile' < 10; +print "ok 12\n"; +} +{ +print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); +print "ok 13\n"; +print $f "a row\n"; +print "not " unless close($f); +print "ok 14\n"; +print "not " unless -s 'afile' > 10; +print "ok 15\n"; +} +{ +print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); +print "ok 16\n"; +@rows = <$f>; +print "not " unless @rows == 2; +print "ok 17\n"; +print "not " unless close($f); +print "ok 18\n"; +} +{ +print "not " unless -s 'afile' < 20; +print "ok 19\n"; +print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); +print "ok 20\n"; +@rows = <$f>; +print "not " unless @rows == 2; +print "ok 21\n"; +seek $f, 0, 1; +print $f "yet another row\n"; +print "not " unless close($f); +print "ok 22\n"; +print "not " unless -s 'afile' > 20; +print "ok 23\n"; + +unlink("afile"); +} +{ +print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); +perl -e "print qq(a row\n); print qq(another row\n)" +EOC +print "ok 24\n"; +@rows = <$f>; +print "not " unless @rows == 2; +print "ok 25\n"; +print "not " unless close($f); +print "ok 26\n"; +} +{ +print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); +perl -pe "s/^not //" +EOC +print "ok 27\n"; +@rows = <$f>; +print $f "not ok 28\n"; +print $f "not ok 29\n"; +print "#\nnot " unless close($f); +sleep 1; +print "ok 30\n"; +} +eval <<'EOE' and print "not "; +open my $f, '<&', 'afile'; +1; +EOE +print "ok 31\n"; +$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; +print "ok 32\n"; |