diff options
| -rw-r--r-- | doio.c | 186 | ||||
| -rw-r--r-- | dosish.h | 2 | ||||
| -rw-r--r-- | embed.h | 8 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | epoc/epocish.h | 2 | ||||
| -rw-r--r-- | lib/open.pm | 70 | ||||
| -rw-r--r-- | mpeix/mpeixish.h | 2 | ||||
| -rw-r--r-- | op.c | 30 | ||||
| -rw-r--r-- | op.h | 6 | ||||
| -rw-r--r-- | opcode.h | 4 | ||||
| -rwxr-xr-x | opcode.pl | 4 | ||||
| -rw-r--r-- | os2/os2ish.h | 2 | ||||
| -rw-r--r-- | perl.h | 14 | ||||
| -rw-r--r-- | plan9/plan9ish.h | 2 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 25 | ||||
| -rw-r--r-- | pp.sym | 1 | ||||
| -rw-r--r-- | pp_proto.h | 1 | ||||
| -rw-r--r-- | pp_sys.c | 15 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | vms/vmsish.h | 2 | ||||
| -rw-r--r-- | vos/vosish.h | 2 |
21 files changed, 308 insertions, 72 deletions
@@ -93,9 +93,19 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int fd; int result; bool was_fdopen = FALSE; + bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0; PL_forkprocess = 1; /* assume true if no fork */ + if (PL_op && PL_op->op_type == OP_OPEN) { + /* set up disciplines */ + U8 flags = PL_op->op_private; + in_raw = (flags & OPpOPEN_IN_RAW); + in_crlf = (flags & OPpOPEN_IN_CRLF); + out_raw = (flags & OPpOPEN_OUT_RAW); + out_crlf = (flags & OPpOPEN_OUT_CRLF); + } + if (IoIFP(io)) { fd = PerlIO_fileno(IoIFP(io)); if (IoTYPE(io) == '-') @@ -153,15 +163,28 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (fd == -1) fp = NULL; else { - char *fpmode; + char fpmode[4]; + STRLEN ix = 0; if (result == O_RDONLY) - fpmode = "r"; + fpmode[ix++] = 'r'; #ifdef O_APPEND - else if (rawmode & O_APPEND) - fpmode = (result == O_WRONLY) ? "a" : "a+"; + else if (rawmode & O_APPEND) { + fpmode[ix++] = 'a'; + if (result != O_WRONLY) + fpmode[ix++] = '+'; + } #endif - else - fpmode = (result == O_WRONLY) ? "w" : "r+"; + else { + if (result == O_WRONLY) + fpmode[ix++] = 'w'; + else { + fpmode[ix++] = 'r'; + fpmode[ix++] = '+'; + } + } + if (rawmode & O_BINARY) + fpmode[ix++] = 'b'; + fpmode[ix] = '\0'; fp = PerlIO_fdopen(fd, fpmode); if (!fp) PerlLIO_close(fd); @@ -172,7 +195,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, char *oname = name; STRLEN tlen; STRLEN olen = len; - char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ + char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ int dodup; type = savepvn(name, len); @@ -191,7 +214,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, name = type; len = tlen; } - mode[0] = mode[1] = mode[2] = '\0'; + mode[0] = mode[1] = mode[2] = mode[3] = '\0'; IoTYPE(io) = *type; if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */ mode[1] = *type++; @@ -226,7 +249,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); } - fp = PerlProc_popen(name,"w"); + { + char *mode; + if (out_raw) + mode = "wb"; + else if (out_crlf) + mode = "wt"; + else + mode = "w"; + fp = PerlProc_popen(name,mode); + } writing = 1; } else if (*type == '>') { @@ -241,6 +273,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, mode[0] = 'w'; writing = 1; + if (out_raw) + strcat(mode, "b"); + else if (out_crlf) + strcat(mode, "t"); + if (num_svs && tlen != 1) goto unknown_desr; if (*type == '&') { @@ -317,6 +354,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, /*SUPPRESS 530*/ for (type++; isSPACE(*type); type++) ; mode[0] = 'r'; + if (in_raw) + strcat(mode, "b"); + else if (in_crlf) + strcat(mode, "t"); + if (*type == '&') { name = type; goto duplicity; @@ -351,7 +393,16 @@ 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"); - fp = PerlProc_popen(name,"r"); + { + char *mode; + if (in_raw) + mode = "rb"; + else if (in_crlf) + mode = "rt"; + else + mode = "r"; + fp = PerlProc_popen(name,mode); + } IoTYPE(io) = '|'; } else { @@ -365,8 +416,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, fp = PerlIO_stdin(); IoTYPE(io) = '-'; } - else - fp = PerlIO_open(name,"r"); + else { + char *mode; + if (in_raw) + mode = "rb"; + else if (in_crlf) + mode = "rt"; + else + mode = "r"; + fp = PerlIO_open(name,mode); + } } } if (!fp) { @@ -444,8 +503,17 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (writing) { dTHR; if (IoTYPE(io) == 's' - || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) { - if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) { + || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) + { + char *mode; + if (out_raw) + mode = "wb"; + else if (out_crlf) + mode = "wt"; + else + mode = "w"; + + if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) { PerlIO_close(fp); IoIFP(io) = Nullfp; goto say_false; @@ -902,19 +970,72 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) } int -Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag) +Perl_mode_from_discipline(pTHX_ SV *discp) +{ + int mode = O_BINARY; + if (discp) { + STRLEN len; + char *s = SvPV(discp,len); + while (*s) { + if (*s == ':') { + switch (s[1]) { + case 'r': + if (len > 3 && strnEQ(s+1, "raw", 3) + && (!s[4] || s[4] == ':' || isSPACE(s[4]))) + { + mode = O_BINARY; + s += 4; + len -= 4; + break; + } + /* FALL THROUGH */ + case 'c': + if (len > 4 && strnEQ(s+1, "crlf", 4) + && (!s[5] || s[5] == ':' || isSPACE(s[5]))) + { + mode = O_TEXT; + s += 5; + len -= 5; + break; + } + /* FALL THROUGH */ + default: + goto fail_discipline; + } + } + else if (isSPACE(*s)) { + ++s; + --len; + } + else { + char *end; +fail_discipline: + end = strchr(s+1, ':'); + if (!end) + end = s+len; + Perl_croak(aTHX_ "Unknown discipline '%.*s'", end-s, s); + } + } + } + return mode; +} + +int +Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) { - if (flag != TRUE) - Perl_croak(aTHX_ "panic: unsetting binmode"); /* Not implemented yet */ #ifdef DOSISH -#if defined(atarist) || defined(__MINT__) - if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN)) +# if defined(atarist) || defined(__MINT__) + if (!PerlIO_flush(fp)) { + if (mode & O_BINARY) + ((FILE*)fp)->_flag |= _IOBIN; + else + ((FILE*)fp)->_flag &= ~ _IOBIN; return 1; - else - return 0; -#else - if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) { -#if defined(WIN32) && defined(__BORLANDC__) + } + return 0; +# else + if (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1) { +# if defined(WIN32) && defined(__BORLANDC__) /* The translation mode of the stream is maintained independent * of the translation mode of the fd in the Borland RTL (heavy * digging through their runtime sources reveal). User has to @@ -922,22 +1043,25 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag) * document this anywhere). GSAR 97-5-24 */ PerlIO_seek(fp,0L,0); - ((FILE*)fp)->flags |= _F_BIN; -#endif + if (mode & O_BINARY) + ((FILE*)fp)->flags |= _F_BIN; + else + ((FILE*)fp)->flags &= ~ _F_BIN; +# endif return 1; } else return 0; -#endif +# endif #else -#if defined(USEMYBINMODE) - if (my_binmode(fp,iotype) != FALSE) +# if defined(USEMYBINMODE) + if (my_binmode(fp, iotype, mode) != FALSE) return 1; else return 0; -#else +# else return 1; -#endif +# endif #endif } @@ -52,7 +52,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ @@ -395,6 +395,7 @@ #define mg_set Perl_mg_set #define mg_size Perl_mg_size #define mod Perl_mod +#define mode_from_discipline Perl_mode_from_discipline #define moreswitches Perl_moreswitches #define my Perl_my #define my_atof Perl_my_atof @@ -1141,6 +1142,7 @@ #define ck_match Perl_ck_match #define ck_method Perl_ck_method #define ck_null Perl_ck_null +#define ck_open Perl_ck_open #define ck_repeat Perl_ck_repeat #define ck_require Perl_ck_require #define ck_rfun Perl_ck_rfun @@ -1835,6 +1837,7 @@ #define mg_set(a) Perl_mg_set(aTHX_ a) #define mg_size(a) Perl_mg_size(aTHX_ a) #define mod(a,b) Perl_mod(aTHX_ a,b) +#define mode_from_discipline(a) Perl_mode_from_discipline(aTHX_ a) #define moreswitches(a) Perl_moreswitches(aTHX_ a) #define my(a) Perl_my(aTHX_ a) #define my_atof(a) Perl_my_atof(aTHX_ a) @@ -2571,6 +2574,7 @@ #define ck_match(a) Perl_ck_match(aTHX_ a) #define ck_method(a) Perl_ck_method(aTHX_ a) #define ck_null(a) Perl_ck_null(aTHX_ a) +#define ck_open(a) Perl_ck_open(aTHX_ a) #define ck_repeat(a) Perl_ck_repeat(aTHX_ a) #define ck_require(a) Perl_ck_require(aTHX_ a) #define ck_rfun(a) Perl_ck_rfun(aTHX_ a) @@ -3600,6 +3604,8 @@ #define mg_size Perl_mg_size #define Perl_mod CPerlObj::Perl_mod #define mod Perl_mod +#define Perl_mode_from_discipline CPerlObj::Perl_mode_from_discipline +#define mode_from_discipline Perl_mode_from_discipline #define Perl_moreswitches CPerlObj::Perl_moreswitches #define moreswitches Perl_moreswitches #define Perl_my CPerlObj::Perl_my @@ -4991,6 +4997,8 @@ #define ck_method Perl_ck_method #define Perl_ck_null CPerlObj::Perl_ck_null #define ck_null Perl_ck_null +#define Perl_ck_open CPerlObj::Perl_ck_open +#define ck_open Perl_ck_open #define Perl_ck_repeat CPerlObj::Perl_ck_repeat #define ck_repeat Perl_ck_repeat #define Perl_ck_require CPerlObj::Perl_ck_require @@ -1692,6 +1692,7 @@ Apd |void |mg_magical |SV* sv Apd |int |mg_set |SV* sv Ap |I32 |mg_size |SV* sv p |OP* |mod |OP* o|I32 type +p |int |mode_from_discipline|SV* discp Ap |char* |moreswitches |char* s p |OP* |my |OP* o Ap |NV |my_atof |const char *s diff --git a/epoc/epocish.h b/epoc/epocish.h index ca992cfdfb..f4be0ff677 100644 --- a/epoc/epocish.h +++ b/epoc/epocish.h @@ -36,7 +36,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/lib/open.pm b/lib/open.pm index da8a04453c..8f5c13833b 100644 --- a/lib/open.pm +++ b/lib/open.pm @@ -1,4 +1,27 @@ package open; +$open::hint_bits = 0x20000; + +sub import { + shift; + die "`use open' needs explicit list of disciplines" unless @_; + $^H |= $open::hint_bits; + while (@_) { + my $type = shift; + if ($type =~ /^(IN|OUT)\z/s) { + my $discp = shift; + unless ($discp =~ /^\s*:(raw|crlf)\s*\z/s) { + die "Unknown discipline '$discp'"; + } + $^H{"open_$type"} = $discp; + } + else { + die "Unknown discipline class '$type'"; + } + } +} + +1; +__END__ =head1 NAME @@ -6,31 +29,48 @@ open - perl pragma to set default disciplines for input and output =head1 SYNOPSIS - use open IN => ":any", OUT => ":utf8"; # unimplemented + use open IN => ":crlf", OUT => ":raw"; =head1 DESCRIPTION -NOTE: This pragma is not yet implemented. - The open pragma is used to declare one or more default disciplines for -I/O operations. Any constructors for file, socket, pipe, or directory -handles found within the lexical scope of this pragma will use the -declared default. +I/O operations. Any open() and readpipe() (aka qx//) operators found +within the lexical scope of this pragma will use the declared defaults. +Neither open() with an explicit set of disciplines, nor sysopen() are +not influenced by this pragma. + +Only the two pseudo-disciplines ":raw" and ":crlf" are currently +available. + +The ":raw" discipline corresponds to "binary mode" and the ":crlf" +discipline corresponds to "text mode" on platforms that distinguish +between the two modes when opening files (which is many DOS-like +platforms, including Windows). These two disciplines are currently +no-ops on platforms where binmode() is a no-op, but will be +supported everywhere in future. -Handle constructors that are called with an explicit set of disciplines -are not influenced by the declared defaults. +=head1 UNIMPLEMENTED FUNCTIONALITY -The default disciplines so declared are available by the special -discipline name ":def", and can be used within handle constructors -that allow disciplines to be specified. This makes it possible to -stack new disciplines over the default ones. +Full-fledged support for I/O disciplines is currently unimplemented. +When they are eventually supported, this pragma will serve as one of +the interfaces to declare default disciplines for all I/O. + +In future, any default disciplines declared by this pragma will be +available by the special discipline name ":def", and could be used +within handle constructors that allow disciplines to be specified. +This would make it possible to stack new disciplines over the default +ones. open FH, "<:para :def", $file or die "can't open $file: $!"; +Socket and directory handles will also support disciplines in +future. + +Full support for I/O disciplines will enable all of the supported +disciplines to work on all platforms. + =head1 SEE ALSO -L<perlunicode>, L<perlfunc/"open"> +L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode> =cut - -1; diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h index b5e4fa4455..562462106b 100644 --- a/mpeix/mpeixish.h +++ b/mpeix/mpeixish.h @@ -34,7 +34,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ @@ -5836,6 +5836,36 @@ Perl_ck_null(pTHX_ OP *o) } OP * +Perl_ck_open(pTHX_ OP *o) +{ + HV *table = GvHV(PL_hintgv); + if (table) { + SV **svp; + I32 mode; + svp = hv_fetch(table, "open_IN", 7, FALSE); + if (svp && *svp) { + mode = mode_from_discipline(*svp); + if (mode & O_BINARY) + o->op_private |= OPpOPEN_IN_RAW; + else if (mode & O_TEXT) + o->op_private |= OPpOPEN_IN_CRLF; + } + + svp = hv_fetch(table, "open_OUT", 8, FALSE); + if (svp && *svp) { + mode = mode_from_discipline(*svp); + if (mode & O_BINARY) + o->op_private |= OPpOPEN_OUT_RAW; + else if (mode & O_TEXT) + o->op_private |= OPpOPEN_OUT_CRLF; + } + } + if (o->op_type == OP_BACKTICK) + return o; + return ck_fun(o); +} + +OP * Perl_ck_repeat(pTHX_ OP *o) { if (cBINOPo->op_first->op_flags & OPf_PARENS) { @@ -197,6 +197,12 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_THREADSV */ #define OPpDONE_SVREF 64 /* Been through newSVREF once */ +/* Private for OP_OPEN and OP_BACKTICK */ +#define OPpOPEN_IN_RAW 16 /* binmode(F,":raw") on input fh */ +#define OPpOPEN_IN_CRLF 32 /* binmode(F,":crlf") on input fh */ +#define OPpOPEN_OUT_RAW 64 /* binmode(F,":raw") on output fh */ +#define OPpOPEN_OUT_CRLF 128 /* binmode(F,":crlf") on output fh */ + struct op { BASEOP }; @@ -1118,7 +1118,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_null), /* srefgen */ MEMBER_TO_FPTR(Perl_ck_fun), /* ref */ MEMBER_TO_FPTR(Perl_ck_fun), /* bless */ - MEMBER_TO_FPTR(Perl_ck_null), /* backtick */ + MEMBER_TO_FPTR(Perl_ck_open), /* backtick */ MEMBER_TO_FPTR(Perl_ck_glob), /* glob */ MEMBER_TO_FPTR(Perl_ck_null), /* readline */ MEMBER_TO_FPTR(Perl_ck_null), /* rcatline */ @@ -1285,7 +1285,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_null), /* dump */ MEMBER_TO_FPTR(Perl_ck_null), /* goto */ MEMBER_TO_FPTR(Perl_ck_fun), /* exit */ - MEMBER_TO_FPTR(Perl_ck_fun), /* open */ + MEMBER_TO_FPTR(Perl_ck_open), /* open */ MEMBER_TO_FPTR(Perl_ck_fun), /* close */ MEMBER_TO_FPTR(Perl_ck_fun), /* pipe_op */ MEMBER_TO_FPTR(Perl_ck_fun), /* fileno */ @@ -377,7 +377,7 @@ bless bless ck_fun s@ S S? # Pushy I/O. -backtick quoted execution (``, qx) ck_null t% +backtick quoted execution (``, qx) ck_open t% # glob defaults its first arg to $_ glob glob ck_glob t@ S? readline <HANDLE> ck_null t% @@ -605,7 +605,7 @@ exit exit ck_fun ds% S? # I/O. -open open ck_fun ist@ F S? L +open open ck_open ist@ F S? L close close ck_fun is% F? pipe_op pipe ck_fun is@ F F diff --git a/os2/os2ish.h b/os2/os2ish.h index 8b7613eb32..76d1b8c4f3 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -19,7 +19,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ @@ -1778,13 +1778,13 @@ typedef pthread_key_t perl_key; #if defined(__CYGWIN__) /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ # define USEMYBINMODE / **/ -# define my_binmode(fp, iotype) \ - (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : FALSE) +# define my_binmode(fp, iotype, mode) \ + (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE) #endif #ifdef UNION_ANY_DEFINITION @@ -3225,6 +3225,14 @@ typedef struct am_table_short AMTS; # define O_CREAT 0100 #endif +#ifndef O_BINARY +# define O_BINARY 0 +#endif + +#ifndef O_TEXT +# define O_TEXT 0 +#endif + #ifdef IAMSUID #ifdef I_SYS_STATVFS diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h index bac6a92d8f..6fb59663f3 100644 --- a/plan9/plan9ish.h +++ b/plan9/plan9ish.h @@ -54,7 +54,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 650a00a842..2f342900a1 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -443,21 +443,28 @@ L<perlipc/"Sockets: Client/Server Communication">. =item binmode FILEHANDLE -Arranges for FILEHANDLE to be read or written in "binary" mode on -systems where the run-time libraries distinguish between binary and +Arranges for FILEHANDLE to be read or written in "binary" or "text" mode +on systems where the run-time libraries distinguish between binary and text files. If FILEHANDLE is an expression, the value is taken as the -name of the filehandle. binmode() should be called after open() but -before any I/O is done on the filehandle. The only way to reset -binary mode on a filehandle is to reopen the file. +name of the filehandle. DISCIPLINE can be either of C<":raw"> for +binary mode or C<":crlf"> for "text" mode. If the DISCIPLINE is +omitted, it defaults to C<":raw">. -On many systems binmode() has no effect, and on some systems it is -necessary when you're not working with a text file. For the sake of -portability it is a good idea to always use it when appropriate, and -to never use it when it isn't appropriate. +binmode() should be called after open() but before any I/O is done on +the filehandle. + +On many systems binmode() currently has no effect, but in future, it +will be extended to support user-defined input and output disciplines. +On some systems binmode() is necessary when you're not working with a +text file. For the sake of portability it is a good idea to always use +it when appropriate, and to never use it when it isn't appropriate. In other words: Regardless of platform, use binmode() on binary files, and do not use binmode() on text files. +The C<open> pragma can be used to establish default disciplines. +See L<open>. + The operating system, device drivers, C libraries, and Perl run-time system all work together to let the programmer treat a single character (C<\n>) as the line terminator, irrespective of the external @@ -26,6 +26,7 @@ Perl_ck_listiob Perl_ck_match Perl_ck_method Perl_ck_null +Perl_ck_open Perl_ck_repeat Perl_ck_require Perl_ck_rfun diff --git a/pp_proto.h b/pp_proto.h index 3fa494ed1f..7f2d80b0b1 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -25,6 +25,7 @@ PERL_CKDEF(Perl_ck_listiob) PERL_CKDEF(Perl_ck_match) PERL_CKDEF(Perl_ck_method) PERL_CKDEF(Perl_ck_null) +PERL_CKDEF(Perl_ck_open) PERL_CKDEF(Perl_ck_repeat) PERL_CKDEF(Perl_ck_require) PERL_CKDEF(Perl_ck_rfun) @@ -304,9 +304,14 @@ PP(pp_backtick) STRLEN n_a; char *tmps = POPpx; I32 gimme = GIMME_V; + char *mode = "r"; TAINT_PROPER("``"); - fp = PerlProc_popen(tmps, "r"); + if (PL_op->op_private & OPpOPEN_IN_RAW) + mode = "rb"; + else if (PL_op->op_private & OPpOPEN_IN_CRLF) + mode = "rt"; + fp = PerlProc_popen(tmps, mode); if (fp) { if (gimme == G_VOID) { char tmpbuf[256]; @@ -687,15 +692,20 @@ PP(pp_binmode) IO *io; PerlIO *fp; MAGIC *mg; + SV *discp = Nullsv; if (MAXARG < 1) RETPUSHUNDEF; + if (MAXARG > 1) + discp = POPs; gv = (GV*)POPs; if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); + if (discp) + XPUSHs(discp); PUTBACK; ENTER; call_method("BINMODE", G_SCALAR); @@ -708,13 +718,12 @@ PP(pp_binmode) if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; - if (do_binmode(fp,IoTYPE(io),TRUE)) + if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp))) RETPUSHYES; else RETPUSHUNDEF; } - PP(pp_tie) { djSP; @@ -468,6 +468,7 @@ PERL_CALLCONV void Perl_mg_magical(pTHX_ SV* sv); PERL_CALLCONV int Perl_mg_set(pTHX_ SV* sv); PERL_CALLCONV I32 Perl_mg_size(pTHX_ SV* sv); PERL_CALLCONV OP* Perl_mod(pTHX_ OP* o, I32 type); +PERL_CALLCONV int Perl_mode_from_discipline(pTHX_ SV* discp); PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s); PERL_CALLCONV OP* Perl_my(pTHX_ OP* o); PERL_CALLCONV NV Perl_my_atof(pTHX_ const char *s); diff --git a/vms/vmsish.h b/vms/vmsish.h index 55401f7f6b..12b13696ce 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -307,7 +307,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ diff --git a/vos/vosish.h b/vos/vosish.h index c5c819a57b..5a6b0796f8 100644 --- a/vos/vosish.h +++ b/vos/vosish.h @@ -36,7 +36,7 @@ /* USEMYBINMODE * This symbol, if defined, indicates that the program should - * use the routine my_binmode(FILE *fp, char iotype) to insure + * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure * that a file is in "binary" mode -- that is, that no translation * of bytes occurs on read or write operations. */ |