Commit | Line | Data |
635c7876 |
1 | #!/usr/local/bin/perl -w |
2 | |
3 | use strict ; |
99709852 |
4 | use File::Slurp ; |
635c7876 |
5 | |
6 | use Carp ; |
7 | use POSIX qw( :fcntl_h ) ; |
8 | use Socket ; |
9 | use Symbol ; |
10 | use Test::More ; |
11 | |
12 | # in case SEEK_SET isn't defined in older perls. it seems to always be 0 |
13 | |
14 | BEGIN { |
99709852 |
15 | *SEEK_SET = sub() { 0 } unless defined \&SEEK_SET ; |
635c7876 |
16 | } |
17 | |
18 | my @pipe_data = ( |
19 | '', |
20 | 'abc', |
21 | 'abc' x 100_000, |
22 | 'abc' x 1_000_000, |
23 | ) ; |
24 | |
635c7876 |
25 | plan( tests => scalar @pipe_data ) ; |
26 | |
635c7876 |
27 | #test_data_slurp() ; |
28 | |
29 | #test_fork_pipe_slurp() ; |
30 | |
31 | SKIP: { |
32 | |
33 | eval { test_socketpair_slurp() } ; |
34 | |
35 | skip "socketpair not found in this Perl", scalar( @pipe_data ) if $@ ; |
36 | } |
37 | |
38 | sub test_socketpair_slurp { |
39 | |
40 | foreach my $data ( @pipe_data ) { |
41 | |
42 | my $size = length( $data ) ; |
43 | |
44 | my $read_fh = gensym ; |
45 | my $write_fh = gensym ; |
46 | |
47 | socketpair( $read_fh, $write_fh, |
48 | AF_UNIX, SOCK_STREAM, PF_UNSPEC); |
12444d55 |
49 | |
635c7876 |
50 | if ( fork() ) { |
51 | |
52 | #warn "PARENT SOCKET\n" ; |
53 | close( $write_fh ) ; |
54 | my $read_buf = read_file( $read_fh ) ; |
55 | |
56 | is( $read_buf, $data, |
57 | "socket slurp/spew of $size bytes" ) ; |
58 | |
59 | } |
60 | else { |
61 | |
62 | #child |
63 | #warn "CHILD SOCKET\n" ; |
64 | close( $read_fh ) ; |
12444d55 |
65 | eval { write_file( $write_fh, $data ) } ; |
635c7876 |
66 | exit() ; |
67 | } |
68 | } |
69 | } |
70 | |
71 | sub test_data_slurp { |
72 | |
73 | my $data_seek = tell( \*DATA ); |
74 | |
75 | # first slurp in the lines |
76 | my @slurp_lines = read_file( \*DATA ) ; |
77 | |
78 | # now seek back and read all the lines with the <> op and we make |
79 | # golden data sets |
80 | |
81 | seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; |
82 | my @data_lines = <DATA> ; |
83 | my $data_text = join( '', @data_lines ) ; |
84 | |
85 | # now slurp in as one string and test |
86 | |
87 | sysseek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; |
88 | my $slurp_text = read_file( \*DATA ) ; |
89 | is( $slurp_text, $data_text, 'scalar slurp DATA' ) ; |
90 | |
91 | # test the array slurp |
92 | |
93 | ok( eq_array( \@data_lines, \@slurp_lines ), 'list slurp of DATA' ) ; |
94 | } |
95 | |
96 | sub test_fork_pipe_slurp { |
97 | |
98 | foreach my $data ( @pipe_data ) { |
99 | |
100 | test_to_pipe( $data ) ; |
101 | test_from_pipe( $data ) ; |
102 | } |
103 | } |
104 | |
105 | |
106 | sub test_from_pipe { |
107 | |
108 | my( $data ) = @_ ; |
109 | |
110 | my $size = length( $data ) ; |
111 | |
112 | if ( pipe_from_fork( \*READ_FH ) ) { |
113 | |
114 | # parent |
115 | my $read_buf = read_file( \*READ_FH ) ; |
116 | warn "PARENT read\n" ; |
117 | |
118 | is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ; |
119 | |
120 | close \*READ_FH ; |
121 | # return ; |
122 | } |
123 | else { |
124 | # child |
125 | warn "CHILD write\n" ; |
126 | # write_file( \*STDOUT, $data ) ; |
127 | syswrite( \*STDOUT, $data, length( $data ) ) ; |
128 | |
129 | close \*STDOUT; |
130 | exit(0); |
131 | } |
132 | } |
133 | |
134 | |
135 | sub pipe_from_fork { |
136 | |
137 | my ( $parent_fh ) = @_ ; |
138 | |
139 | my $child = gensym ; |
140 | |
141 | pipe( $parent_fh, $child ) or die; |
142 | |
143 | my $pid = fork(); |
144 | die "fork() failed: $!" unless defined $pid; |
145 | |
146 | if ($pid) { |
147 | |
148 | warn "PARENT\n" ; |
149 | close $child; |
150 | return $pid ; |
151 | } |
152 | |
153 | warn "CHILD FILENO ", fileno($child), "\n" ; |
154 | close $parent_fh ; |
155 | open(STDOUT, ">&=" . fileno($child)) or die "no fileno" ; |
156 | |
157 | return ; |
158 | } |
159 | |
160 | |
161 | sub test_to_pipe { |
162 | |
163 | my( $data ) = @_ ; |
164 | |
165 | my $size = length( $data ) ; |
166 | |
167 | if ( pipe_to_fork( \*WRITE_FH ) ) { |
168 | |
169 | # parent |
170 | syswrite( \*WRITE_FH, $data, length( $data ) ) ; |
171 | # write_file( \*WRITE_FH, $data ) ; |
172 | warn "PARENT write\n" ; |
173 | |
174 | # is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ; |
175 | |
176 | close \*WRITE_FH ; |
177 | # return ; |
178 | } |
179 | else { |
180 | # child |
181 | warn "CHILD read FILENO ", fileno(\*STDIN), "\n" ; |
182 | |
183 | my $read_buf = read_file( \*STDIN ) ; |
184 | is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ; |
185 | close \*STDIN; |
186 | exit(0); |
187 | } |
188 | } |
189 | |
190 | sub pipe_to_fork { |
191 | my ( $parent_fh ) = @_ ; |
192 | |
193 | my $child = gensym ; |
194 | |
195 | pipe( $child, $parent_fh ) or die ; |
196 | |
197 | my $pid = fork(); |
198 | die "fork() failed: $!" unless defined $pid; |
199 | |
200 | if ( $pid ) { |
201 | close $child; |
202 | return $pid ; |
203 | } |
204 | |
205 | close $parent_fh ; |
206 | open(STDIN, "<&=" . fileno($child)) or die; |
207 | |
208 | return ; |
209 | } |
210 | |
211 | __DATA__ |
212 | line one |
213 | second line |
214 | more lines |
215 | still more |
216 | |
217 | enough lines |
218 | |
219 | we don't test long handle slurps from DATA since i would have to type |
220 | too much stuff :-) |
221 | |
222 | so we will stop here |