1 #!/usr/local/bin/perl -w
6 use POSIX qw( :fcntl_h ) ;
11 # in case SEEK_SET isn't defined in older perls. it seems to always be 0
14 *SEEK_SET = sub { 0 } unless eval { SEEK_SET() } ;
24 #plan( tests => 2 + @pipe_data ) ;
25 plan( tests => scalar @pipe_data ) ;
29 use_ok( 'File::Slurp', ) ;
34 #test_fork_pipe_slurp() ;
38 eval { test_socketpair_slurp() } ;
40 skip "socketpair not found in this Perl", scalar( @pipe_data ) if $@ ;
43 sub test_socketpair_slurp {
45 foreach my $data ( @pipe_data ) {
47 my $size = length( $data ) ;
49 my $read_fh = gensym ;
50 my $write_fh = gensym ;
52 socketpair( $read_fh, $write_fh,
53 AF_UNIX, SOCK_STREAM, PF_UNSPEC);
57 #warn "PARENT SOCKET\n" ;
59 my $read_buf = read_file( $read_fh ) ;
62 "socket slurp/spew of $size bytes" ) ;
68 #warn "CHILD SOCKET\n" ;
70 write_file( $write_fh, $data ) ;
78 my $data_seek = tell( \*DATA );
80 # first slurp in the lines
81 my @slurp_lines = read_file( \*DATA ) ;
83 # now seek back and read all the lines with the <> op and we make
86 seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ;
87 my @data_lines = <DATA> ;
88 my $data_text = join( '', @data_lines ) ;
90 # now slurp in as one string and test
92 sysseek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ;
93 my $slurp_text = read_file( \*DATA ) ;
94 is( $slurp_text, $data_text, 'scalar slurp DATA' ) ;
96 # test the array slurp
98 ok( eq_array( \@data_lines, \@slurp_lines ), 'list slurp of DATA' ) ;
101 sub test_fork_pipe_slurp {
103 foreach my $data ( @pipe_data ) {
105 test_to_pipe( $data ) ;
106 test_from_pipe( $data ) ;
115 my $size = length( $data ) ;
117 if ( pipe_from_fork( \*READ_FH ) ) {
120 my $read_buf = read_file( \*READ_FH ) ;
121 warn "PARENT read\n" ;
123 is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ;
130 warn "CHILD write\n" ;
131 # write_file( \*STDOUT, $data ) ;
132 syswrite( \*STDOUT, $data, length( $data ) ) ;
142 my ( $parent_fh ) = @_ ;
146 pipe( $parent_fh, $child ) or die;
149 die "fork() failed: $!" unless defined $pid;
158 warn "CHILD FILENO ", fileno($child), "\n" ;
160 open(STDOUT, ">&=" . fileno($child)) or die "no fileno" ;
170 my $size = length( $data ) ;
172 if ( pipe_to_fork( \*WRITE_FH ) ) {
175 syswrite( \*WRITE_FH, $data, length( $data ) ) ;
176 # write_file( \*WRITE_FH, $data ) ;
177 warn "PARENT write\n" ;
179 # is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ;
186 warn "CHILD read FILENO ", fileno(\*STDIN), "\n" ;
188 my $read_buf = read_file( \*STDIN ) ;
189 is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ;
196 my ( $parent_fh ) = @_ ;
200 pipe( $child, $parent_fh ) or die ;
203 die "fork() failed: $!" unless defined $pid;
211 open(STDIN, "<&=" . fileno($child)) or die;
224 we don't test long handle slurps from DATA since i would have to type