#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;
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));
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;
}
}
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))
errno = EPIPE;
goto say_false;
}
- if (strNE(name,"-"))
+ if (strNE(name,"-") || num_svs)
TAINT_ENV();
TAINT_PROPER("piped open");
if (name[strlen(name)-1] == '|') {
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++;
}
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))
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++) ;
#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
#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)
#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
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
Perl_do_join
Perl_do_kv
Perl_do_open
+Perl_do_open9
Perl_do_pipe
Perl_do_print
Perl_do_readline
#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
0x00001a44, /* dump */
0x00001a44, /* goto */
0x00013644, /* exit */
- 0x0012c81c, /* open */
+ 0x0132c81c, /* open */
0x0001d614, /* close */
0x000cc814, /* pipe_op */
0x0000d61c, /* fileno */
# 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
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)
(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
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
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
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
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.
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
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:
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
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.)
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.
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
$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;
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))
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
XPUSHs(sv);
+ if (have_name)
+ XPUSHs(name);
PUTBACK;
ENTER;
call_method("OPEN", G_SCALAR);
}
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);
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);
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 "
$| = 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";
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";
projects / p5sagit/p5-mst-13.2.git / commitdiff