Commit | Line | Data |
d1edabcf |
1 | package open; |
ac27b0f5 |
2 | use Carp; |
16fe6d59 |
3 | $open::hint_bits = 0x20000; |
4 | |
ac27b0f5 |
5 | use vars qw(%layers @layers); |
6 | |
7 | # Populate hash in non-PerlIO case |
8 | %layers = (crlf => 1, raw => 0) unless (@layers); |
9 | |
b75c8c73 |
10 | our $VERSION = '1.00'; |
11 | |
16fe6d59 |
12 | sub import { |
13 | shift; |
14 | die "`use open' needs explicit list of disciplines" unless @_; |
15 | $^H |= $open::hint_bits; |
ac27b0f5 |
16 | my ($in,$out) = split(/\0/,(${^OPEN} || '\0')); |
17 | my @in = split(/\s+/,$in); |
18 | my @out = split(/\s+/,$out); |
16fe6d59 |
19 | while (@_) { |
20 | my $type = shift; |
ac27b0f5 |
21 | my $discp = shift; |
22 | my @val; |
23 | foreach my $layer (split(/\s+:?/,$discp)) { |
24 | unless(exists $layers{$layer}) { |
25 | croak "Unknown discipline layer '$layer'"; |
26 | } |
27 | push(@val,":$layer"); |
28 | if ($layer =~ /^(crlf|raw)$/) { |
29 | $^H{"open_$type"} = $layer; |
16fe6d59 |
30 | } |
ac27b0f5 |
31 | } |
32 | if ($type eq 'IN') { |
33 | $in = join(' ',@val); |
34 | } |
35 | elsif ($type eq 'OUT') { |
36 | $out = join(' ',@val); |
16fe6d59 |
37 | } |
38 | else { |
ac27b0f5 |
39 | croak "Unknown discipline class '$type'"; |
16fe6d59 |
40 | } |
41 | } |
ac27b0f5 |
42 | ${^OPEN} = join('\0',$in,$out); |
16fe6d59 |
43 | } |
44 | |
45 | 1; |
46 | __END__ |
d1edabcf |
47 | |
48 | =head1 NAME |
49 | |
50 | open - perl pragma to set default disciplines for input and output |
51 | |
52 | =head1 SYNOPSIS |
53 | |
16fe6d59 |
54 | use open IN => ":crlf", OUT => ":raw"; |
d1edabcf |
55 | |
56 | =head1 DESCRIPTION |
57 | |
d1edabcf |
58 | The open pragma is used to declare one or more default disciplines for |
16fe6d59 |
59 | I/O operations. Any open() and readpipe() (aka qx//) operators found |
60 | within the lexical scope of this pragma will use the declared defaults. |
61 | Neither open() with an explicit set of disciplines, nor sysopen() are |
642f9deb |
62 | influenced by this pragma. |
16fe6d59 |
63 | |
64 | Only the two pseudo-disciplines ":raw" and ":crlf" are currently |
65 | available. |
66 | |
67 | The ":raw" discipline corresponds to "binary mode" and the ":crlf" |
68 | discipline corresponds to "text mode" on platforms that distinguish |
69 | between the two modes when opening files (which is many DOS-like |
70 | platforms, including Windows). These two disciplines are currently |
71 | no-ops on platforms where binmode() is a no-op, but will be |
72 | supported everywhere in future. |
d1edabcf |
73 | |
16fe6d59 |
74 | =head1 UNIMPLEMENTED FUNCTIONALITY |
d1edabcf |
75 | |
16fe6d59 |
76 | Full-fledged support for I/O disciplines is currently unimplemented. |
77 | When they are eventually supported, this pragma will serve as one of |
78 | the interfaces to declare default disciplines for all I/O. |
79 | |
80 | In future, any default disciplines declared by this pragma will be |
9bafe919 |
81 | available by the special discipline name ":DEFAULT", and could be used |
16fe6d59 |
82 | within handle constructors that allow disciplines to be specified. |
83 | This would make it possible to stack new disciplines over the default |
84 | ones. |
d1edabcf |
85 | |
9bafe919 |
86 | open FH, "<:para :DEFAULT", $file or die "can't open $file: $!"; |
d1edabcf |
87 | |
16fe6d59 |
88 | Socket and directory handles will also support disciplines in |
89 | future. |
90 | |
91 | Full support for I/O disciplines will enable all of the supported |
92 | disciplines to work on all platforms. |
93 | |
d1edabcf |
94 | =head1 SEE ALSO |
95 | |
16fe6d59 |
96 | L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode> |
d1edabcf |
97 | |
98 | =cut |