line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
require 5; |
3
|
|
|
|
|
|
|
# Time-stamp: "2004-12-29 19:09:59 AST" |
4
|
|
|
|
|
|
|
package IO::Null; |
5
|
2
|
|
|
2
|
|
21073
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
102
|
|
6
|
2
|
|
|
2
|
|
11
|
use vars qw($VERSION @ISA); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
123
|
|
7
|
|
|
|
|
|
|
#use Carp (); |
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
2146
|
use IO::Handle (); |
|
2
|
|
|
|
|
59492
|
|
|
2
|
|
|
|
|
1743
|
|
10
|
|
|
|
|
|
|
@ISA = ('IO::Handle'); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
$VERSION = "1.01"; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
IO::Null -- class for null filehandles |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use IO::Null; |
21
|
|
|
|
|
|
|
my $fh = IO::Null->new; |
22
|
|
|
|
|
|
|
print $fh "I have nothing to say\n"; # does nothing. |
23
|
|
|
|
|
|
|
# or: |
24
|
|
|
|
|
|
|
$fh->print("And I'm saying it.\n"); # ditto. |
25
|
|
|
|
|
|
|
# or: |
26
|
|
|
|
|
|
|
my $old = select($fh); |
27
|
|
|
|
|
|
|
print "and that is poetry / as I needed it --John Cage"; # nada! |
28
|
|
|
|
|
|
|
select($old); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Or even: |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
tie(*FOO, IO::Null); |
33
|
|
|
|
|
|
|
print FOO "Lalalalala!\n"; # does nothing. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DESCRIPTION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
This is a class for null filehandles. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Calling a constructor of this class always succeeds, returning |
40
|
|
|
|
|
|
|
a new null filehandle. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Writing to any object of this class is always a no-operation, |
43
|
|
|
|
|
|
|
and returns true. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Reading from any object of this class is always no-operation, |
46
|
|
|
|
|
|
|
and returns empty-string or empty-list, as appropriate. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 WHY |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
You could say: |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
open(NULL, '>/dev/null') || die "WHAAT?! $!"; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
and get a null FH that way. But not everyone is using an OS that |
55
|
|
|
|
|
|
|
has a C |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 IMPLEMENTATION |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This is a subclass of IO::Handle. Applicable methods with |
60
|
|
|
|
|
|
|
subs that do nothing, and return an appropriate value. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 SEE ALSO |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
L, L, I |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 CAVEATS |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
* This: |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
use IO::Null; |
71
|
|
|
|
|
|
|
$^W = 1; # turn on warnings |
72
|
|
|
|
|
|
|
tie(*FOO, IO::Null); |
73
|
|
|
|
|
|
|
print FOO "Lalalalala!\n"; # does nothing. |
74
|
|
|
|
|
|
|
untie(*FOO); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
has been known to produce this odd warning: |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
untie attempted while 3 inner references still exist. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
and I've no idea why. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
* Furthermore, this: |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
use IO::Null; |
85
|
|
|
|
|
|
|
$^W = 1; |
86
|
|
|
|
|
|
|
*FOO = IO::Null->new; |
87
|
|
|
|
|
|
|
print FOO "Lalalalala!\n"; # does nothing. |
88
|
|
|
|
|
|
|
close(FOO); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
emits these warnings: |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Filehandle main::FOO never opened. |
93
|
|
|
|
|
|
|
Close on unopened file . |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
...which are, in fact, true; the FH behind the FOO{IO} was never |
96
|
|
|
|
|
|
|
opened on any real filehandle. (I'd welcome anyone's (working) |
97
|
|
|
|
|
|
|
suggestions on how to suppress these warnings.) |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
You get the same warnings with: |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
use IO::Null; |
102
|
|
|
|
|
|
|
$^W = 1; |
103
|
|
|
|
|
|
|
my $fh = IO::Null->new; |
104
|
|
|
|
|
|
|
print $fh "Lalalalala!\n"; # does nothing. |
105
|
|
|
|
|
|
|
close $fh; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Note that this, however: |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
use IO::Null; |
110
|
|
|
|
|
|
|
$^W = 1; |
111
|
|
|
|
|
|
|
my $fh = IO::Null->new; |
112
|
|
|
|
|
|
|
$fh->print("Lalalalala!\n"); # does nothing. |
113
|
|
|
|
|
|
|
$fh->close(); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
emits no warnings. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
* I don't know if you can successfully untaint a null filehandle. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
* This: |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
$null_fh->fileno |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
will return a defined and nonzero number, but one you're not likely |
124
|
|
|
|
|
|
|
to want to use for anything. See the source. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
* These docs are longer than the source itself. Read the source! |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 COPYRIGHT |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Copyright (c) 2000 Sean M. Burke. All rights reserved. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
133
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head1 AUTHOR |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Sean M. Burke C |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=cut |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
########################################################################### |
142
|
|
|
|
|
|
|
# Doesn't support handle-untainting (yet)? |
143
|
2
|
|
|
2
|
|
172
|
sub _TRUE { 1 } |
144
|
0
|
|
|
0
|
|
0
|
sub _FALSE { '' } |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
*CLOSE = *PRINT = *PRINTF = *WRITE = |
147
|
|
|
|
|
|
|
*close = *print = *printf = *write = |
148
|
|
|
|
|
|
|
*opened = *eof = *syswrite = *ungetc = *clearerr = *flush = |
149
|
|
|
|
|
|
|
*binmode = \&_TRUE; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
*GETC = *READ = |
152
|
|
|
|
|
|
|
*getc = *read = *error = *getline = \&_FALSE; |
153
|
|
|
|
|
|
|
# is getline ever used? |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub readline { |
156
|
0
|
0
|
|
0
|
0
|
0
|
return() if wantarray; |
157
|
0
|
|
|
|
|
0
|
return ''; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
*READLINE = \&readline; |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
0
|
1
|
0
|
sub getlines { return(); } # empty-list |
162
|
0
|
|
0
|
0
|
0
|
0
|
sub fileno { -1/($_[0] || 2) } # a presumably safe value! |
163
|
0
|
|
|
0
|
|
0
|
sub DESTROY { 1 }; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
*new = *nem_from_fd = *fdopen = \&TIEHANDLE; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub TIEHANDLE { # return the constructed object |
168
|
|
|
|
|
|
|
# Ignores parameters after $_[0] |
169
|
1
|
|
|
1
|
|
453
|
local(*GLOB); |
170
|
|
|
|
|
|
|
# Used to have my $x; bless \$x. |
171
|
|
|
|
|
|
|
# But you can't select($x) something that's not a globref, apparently. |
172
|
1
|
|
33
|
|
|
9
|
return bless \*GLOB, ref($_[0]) || $_[0]; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# TODO: have an AUTOLOAD that returns true? |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
########################################################################### |
178
|
|
|
|
|
|
|
1; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
__END__ |