1 files changed, 222 insertions, 0 deletions
diff --git a/t/handle.t b/t/handle.t
new file mode 100644
index 0000000..4f26847
--- /dev/null
+++ b/t/handle.t
@@ -0,0 +1,222 @@
+#!/usr/local/bin/perl -w
+
+use strict ;
+use File::Slurp ;
+
+use Carp ;
+use POSIX qw( :fcntl_h ) ;
+use Socket ;
+use Symbol ;
+use Test::More ;
+
+# in case SEEK_SET isn't defined in older perls. it seems to always be 0
+
+BEGIN {
+	*SEEK_SET = sub() { 0 } unless defined \&SEEK_SET ;
+}
+
+my @pipe_data = (
+	'',
+	'abc',
+	'abc' x 100_000,
+	'abc' x 1_000_000,
+) ;
+
+plan( tests => scalar @pipe_data ) ;
+
+#test_data_slurp() ;
+
+#test_fork_pipe_slurp() ;
+
+SKIP: {
+
+	eval { test_socketpair_slurp() } ;
+
+	skip "socketpair not found in this Perl", scalar( @pipe_data ) if $@ ;
+}
+
+sub test_socketpair_slurp {
+
+	foreach my $data ( @pipe_data ) {
+
+		my $size = length( $data ) ;
+
+		my $read_fh = gensym ;
+		my $write_fh = gensym ;
+
+		socketpair( $read_fh, $write_fh,
+				AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+
+		if ( fork() ) {
+
+#warn "PARENT SOCKET\n" ;
+			close( $write_fh ) ;
+			my $read_buf = read_file( $read_fh ) ;
+
+			is( $read_buf, $data,
+				"socket slurp/spew of $size bytes" ) ;
+
+		}
+		else {
+
+#child
+#warn "CHILD SOCKET\n" ;
+			close( $read_fh ) ;
+			eval { write_file( $write_fh, $data ) } ;
+			exit() ;
+		}
+	}
+}
+
+sub test_data_slurp {
+
+	my $data_seek = tell( \*DATA );
+
+# first slurp in the lines 
+	my @slurp_lines = read_file( \*DATA ) ;
+
+# now seek back and read all the lines with the <> op and we make
+# golden data sets
+
+	seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ;
+	my @data_lines = <DATA> ;
+	my $data_text = join( '', @data_lines ) ;
+
+# now slurp in as one string and test
+
+	sysseek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ;
+	my $slurp_text = read_file( \*DATA ) ;
+	is( $slurp_text, $data_text, 'scalar slurp DATA' ) ;
+
+# test the array slurp
+
+	ok( eq_array( \@data_lines, \@slurp_lines ), 'list slurp of DATA' ) ;
+}
+
+sub test_fork_pipe_slurp {
+
+	foreach my $data ( @pipe_data ) {
+
+		test_to_pipe( $data ) ;
+		test_from_pipe( $data ) ;
+	}
+}
+
+
+sub test_from_pipe {
+
+	my( $data ) = @_ ;
+
+	my $size = length( $data ) ;
+
+	if ( pipe_from_fork( \*READ_FH ) ) {
+
+# parent
+		my $read_buf = read_file( \*READ_FH ) ;
+warn "PARENT read\n" ;
+
+		is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ;
+
+		close \*READ_FH ;
+#		return ;
+	}
+	else {
+# child
+warn "CHILD write\n" ;
+	#	write_file( \*STDOUT, $data ) ;
+		syswrite( \*STDOUT, $data, length( $data ) ) ;
+
+		close \*STDOUT;
+		exit(0);
+	}
+}
+
+
+sub pipe_from_fork {
+
+	my ( $parent_fh ) = @_ ;
+
+	my $child = gensym ;
+
+	pipe( $parent_fh, $child ) or die;
+
+	my $pid = fork();
+	die "fork() failed: $!" unless defined $pid;
+
+	if ($pid) {
+
+warn "PARENT\n" ;
+		close $child;
+		return $pid ;
+	}
+
+warn "CHILD FILENO ", fileno($child), "\n" ;
+	close $parent_fh ;
+	open(STDOUT, ">&=" . fileno($child)) or die "no fileno" ;
+
+	return ;
+}
+
+
+sub test_to_pipe {
+
+	my( $data ) = @_ ;
+
+	my $size = length( $data ) ;
+
+	if ( pipe_to_fork( \*WRITE_FH ) ) {
+
+# parent
+		syswrite( \*WRITE_FH, $data, length( $data ) ) ;
+#		write_file( \*WRITE_FH, $data ) ;
+warn "PARENT write\n" ;
+
+#		is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ;
+
+		close \*WRITE_FH ;
+#		return ;
+	}
+	else {
+# child
+warn "CHILD read FILENO ", fileno(\*STDIN), "\n" ;
+
+		my $read_buf = read_file( \*STDIN ) ;
+		is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ;
+		close \*STDIN;
+		exit(0);
+	}
+}
+
+sub pipe_to_fork {
+	my ( $parent_fh ) = @_ ;
+
+	my $child = gensym ;
+
+	pipe( $child, $parent_fh ) or die ;
+
+	my $pid = fork();
+	die "fork() failed: $!" unless defined $pid;
+
+	if ( $pid ) {
+		close $child;
+		return $pid ;
+	}
+
+	close $parent_fh ;
+	open(STDIN, "<&=" . fileno($child)) or die;
+
+	return ;
+}
+
+__DATA__
+line one
+second line
+more lines
+still more
+
+enough lines
+
+we don't test long handle slurps from DATA since i would have to type
+too much stuff :-)
+
+so we will stop here