[urisagit/Perl-Docs.git] / extras / slurp_bench.pl

#!/usr/local/bin/perl

use strict ;
use warnings ;

use Getopt::Long ;
use Benchmark qw( timethese cmpthese ) ;
use Carp ;
use FileHandle ;
use Fcntl qw( :DEFAULT :seek );

use File::Slurp () ;
use FileSlurp_12 () ;

my $file_name = 'slurp_data' ;
my( @lines, $text ) ;

my %opts ;

parse_options() ;

run_benchmarks() ;

unlink $file_name ;

exit ;

sub run_benchmarks {

	foreach my $size ( @{$opts{size_list}} ) {

		@lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
		$text = join( '', @lines ) ;

		my $overage = length($text) - $size ;
		substr( $text, -$overage, $overage, '' ) ;
		substr( $lines[-1], -$overage, $overage, '' ) ;

		if ( $opts{slurp} ) {

			File::Slurp::write_file( $file_name, $text ) ;

			bench_list_slurp( $size ) if $opts{list} ;
	 		bench_scalar_slurp( $size ) if $opts{scalar} ;
		}

		if ( $opts{spew} ) {

			bench_spew_list( $size ) if $opts{list} ;
	 		bench_scalar_spew( $size ) if $opts{scalar} ;
		}
	}
}

##########################################
##########################################
sub bench_scalar_slurp {

	my ( $size ) = @_ ;

	print "\n\nReading (Slurp) into a scalar: Size = $size bytes\n\n" ;

	my $buffer ;

	my $result = timethese( $opts{iterations}, {

		'FS::read_file' =>
	    		sub { my $text = File::Slurp::read_file( $file_name ) },

		'FS12::read_file' =>
	    		sub { my $text = FileSlurp_12::read_file( $file_name ) },

		'FS::read_file_buf_ref' =>
	    		sub { my $text ;
			   File::Slurp::read_file( $file_name, buf_ref => \$text ) },
		'FS::read_file_buf_ref2' =>
	    		sub { 
			   File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
		'FS::read_file_scalar_ref' =>
	    		sub { my $text =
			    File::Slurp::read_file( $file_name, scalar_ref => 1 ) },

		old_sysread_file =>
	    		sub { my $text = old_sysread_file( $file_name ) },

		old_read_file =>
	    		sub { my $text = old_read_file( $file_name ) },

		orig_read_file =>
			sub { my $text = orig_read_file( $file_name ) },

		orig_slurp =>
			sub { my $text = orig_slurp_scalar( $file_name ) },

		file_contents =>
			sub { my $text = file_contents( $file_name ) },

		file_contents_no_OO =>
			sub { my $text = file_contents_no_OO( $file_name ) },
	} ) ;

	cmpthese( $result ) ;
}

##########################################

sub bench_list_slurp {

	my ( $size ) = @_ ;

	print "\n\nReading (Slurp) into a list: Size = $size bytes\n\n" ;

	my $result = timethese( $opts{iterations},  {

		'FS::read_file' =>
	    		sub { my @lines = File::Slurp::read_file( $file_name ) },

		'FS::read_file_array_ref' =>
	    		sub { my $lines_ref =
			     File::Slurp::read_file( $file_name, array_ref => 1 ) },

		'FS::read_file_scalar' =>
	    		sub { my $lines_ref =
			     [ File::Slurp::read_file( $file_name ) ] },

		old_sysread_file =>
	    		sub { my @lines = old_sysread_file( $file_name ) },

		old_read_file =>
	    		sub { my @lines = old_read_file( $file_name ) },

		orig_read_file =>
			sub { my @lines = orig_read_file( $file_name ) },

		orig_slurp_array =>
			sub { my @lines = orig_slurp_array( $file_name ) },

		orig_slurp_array_ref =>
			sub { my $lines_ref = orig_slurp_array( $file_name ) },
	} ) ;

	cmpthese( $result ) ;
}

######################################
# uri's old fast slurp

sub old_read_file {

	my( $file_name ) = shift ;

	local( *FH ) ;
	open( FH, $file_name ) || carp "can't open $file_name $!" ;

	return <FH> if wantarray ;

	my $buf ;

	read( FH, $buf, -s FH ) ;
	return $buf ;
}

sub old_sysread_file {

	my( $file_name ) = shift ;

	local( *FH ) ;
	open( FH, $file_name ) || carp "can't open $file_name $!" ;

	return <FH> if wantarray ;

	my $buf ;

	sysread( FH, $buf, -s FH ) ;
	return $buf ;
}

######################################
# from File::Slurp.pm on cpan

sub orig_read_file
{
	my ($file) = @_;

	local($/) = wantarray ? $/ : undef;
	local(*F);
	my $r;
	my (@r);

	open(F, "<$file") || croak "open $file: $!";
	@r = <F>;
	close(F) || croak "close $file: $!";

	return $r[0] unless wantarray;
	return @r;
}


######################################
# from Slurp.pm on cpan

sub orig_slurp { 
    local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ ); 
    return <ARGV>;
}

sub orig_slurp_array {
    my @array = orig_slurp( @_ );
    return wantarray ? @array : \@array;
}

sub orig_slurp_scalar {
    my $scalar = orig_slurp( @_ );
    return $scalar;
}

######################################
# very slow slurp code used by a client

sub file_contents {
    my $file = shift;
    my $fh = new FileHandle $file or
        warn("Util::file_contents:Can't open file $file"), return '';
    return join '', <$fh>;
}

# same code but doesn't use FileHandle.pm

sub file_contents_no_OO {
    my $file = shift;

	local( *FH ) ;
	open( FH, $file ) || carp "can't open $file $!" ;

    return join '', <FH>;
}

##########################################
##########################################

sub bench_spew_list {

	my( $size ) = @_ ;

	print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;

	my $result = timethese( $opts{iterations}, {
 		'FS::write_file'	=> sub { unlink $file_name if $opts{unlink} ; 
			File::Slurp::write_file( $file_name, @lines ) },
 		'FS::write_file Aref'	=> sub { unlink $file_name if $opts{unlink} ; 
			File::Slurp::write_file( $file_name, \@lines ) },
		'print'			=> sub { unlink $file_name if $opts{unlink} ; 
			print_file( $file_name, @lines ) },
		'print/join'		=> sub { unlink $file_name if $opts{unlink} ; 
			print_join_file( $file_name, @lines ) },
		'syswrite/join'		=> sub { unlink $file_name if $opts{unlink} ;
			syswrite_join_file( $file_name, @lines ) },
		'original write_file'	=> sub {  unlink $file_name if $opts{unlink} ; 
			orig_write_file( $file_name, @lines ) },
	} ) ;

	cmpthese( $result ) ;
}

sub print_file {

	my( $file_name ) = shift ;

	local( *FH ) ;
	open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;

	print FH @_ ;
}

sub print_join_file {

	my( $file_name ) = shift ;

	local( *FH ) ;
	open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;

	print FH join( '', @_ ) ;
}

sub syswrite_join_file {

	my( $file_name ) = shift ;

	local( *FH ) ;
	open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;

	syswrite( FH, join( '', @_ ) ) ;
}

sub sysopen_syswrite_join_file {

	my( $file_name ) = shift ;

	local( *FH ) ;
	sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
				carp "can't create $file_name $!" ;

	syswrite( FH, join( '', @_ ) ) ;
}

sub orig_write_file
{
	my ($f, @data) = @_;

	local(*F);

	open(F, ">$f") || croak "open >$f: $!";
	(print F @data) || croak "write $f: $!";
	close(F) || croak "close $f: $!";
	return 1;
}

##########################################

sub bench_scalar_spew {

	my ( $size ) = @_ ;

	print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ;

	my $result = timethese( $opts{iterations}, {
		'FS::write_file'	=> sub { unlink $file_name if $opts{unlink} ;
			File::Slurp::write_file( $file_name, $text ) },
		'FS::write_file Sref'	=> sub { unlink $file_name if $opts{unlink} ; 
			File::Slurp::write_file( $file_name, \$text ) },
		'print'			=> sub { unlink $file_name if $opts{unlink} ; 
			print_file( $file_name, $text ) },
		'syswrite_file'		=> sub { unlink $file_name if $opts{unlink} ; 
			syswrite_file( $file_name, $text ) },
		'syswrite_file_ref'	=> sub { unlink $file_name if $opts{unlink} ; 
			syswrite_file_ref( $file_name, \$text ) },
		'orig_write_file'	=> sub { unlink $file_name if $opts{unlink} ; 
			orig_write_file( $file_name, $text ) },
	} ) ;

	cmpthese( $result ) ;
}

sub syswrite_file {

	my( $file_name, $text ) = @_ ;

	local( *FH ) ;
	open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;

	syswrite( FH, $text ) ;
}

sub syswrite_file_ref {

	my( $file_name, $text_ref ) = @_ ;

	local( *FH ) ;
	open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;

	syswrite( FH, ${$text_ref} ) ;
}

sub parse_options {

	my $result = GetOptions (\%opts, qw(
		iterations|i=s
		direction|d=s
		context|c=s
		sizes|s=s
		unlink|u
		legend|key|l|k
		help|usage
	) ) ;

	usage() unless $result ;

	usage() if $opts{help} ;

	legend() if $opts{legend} ;

# set defaults

	$opts{direction} ||= 'both' ;
	$opts{context} ||= 'both' ;
	$opts{iterations} ||= -2 ;
	$opts{sizes} ||= '512,10k,1m' ;

	if ( $opts{direction} eq 'both' ) {
	
		$opts{spew} = 1 ;
		$opts{slurp} = 1 ;
	}
	elsif ( $opts{direction} eq 'in' ) {

		$opts{slurp} = 1 ;
	
	}
	elsif ( $opts{direction} eq 'out' ) {

		$opts{spew} = 1 ;
	}
	else {

		usage( "Unknown direction: $opts{direction}" ) ;
	}

	if ( $opts{context} eq 'both' ) {
	
		$opts{list} = 1 ;
		$opts{scalar} = 1 ;
	}
	elsif ( $opts{context} eq 'scalar' ) {

		$opts{scalar} = 1 ;
	
	}
	elsif ( $opts{context} eq 'list' ) {

		$opts{list} = 1 ;
	}
	else {

		usage( "Unknown context: $opts{context}" ) ;
	}

	if ( $opts{context} eq 'both' ) {
	
		$opts{list} = 1 ;
		$opts{scalar} = 1 ;
	}
	elsif ( $opts{context} eq 'scalar' ) {

		$opts{scalar} = 1 ;
	
	}
	elsif ( $opts{context} eq 'list' ) {

		$opts{list} = 1 ;
	}
	else {

		usage( "Unknown context: $opts{context}" ) ;
	}

	foreach my $size ( split ',', ( $opts{sizes} ) ) {


# check for valid size and suffix. grab both.

		usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;

# handle suffix multipliers

		$size =  $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;

		push( @{$opts{size_list}}, $size ) ;
	}

#use Data::Dumper ;
#print Dumper \%opts ;
}

sub legend {

	die <<'LEGEND' ;
--------------------------------------------------------------------------
Legend for the Slurp Benchmark Entries

In all cases below 'FS' or 'F::S' means the current File::Slurp module
is being used in the benchmark. The full name and description will say
which options are being used.
--------------------------------------------------------------------------
These benchmarks write a list of lines to a file. Use the direction option
of 'out' or 'both' and the context option is 'list' or 'both'.

	Key			Description/Source
	-----			--------------------------
	FS::write_file		Current F::S write_file
	FS::write_file Aref	Current F::S write_file on array ref of data
	print			Open a file and call print() on the list data
	print/join		Open a file and call print() on the joined list
				data
	syswrite/join		Open a file, call syswrite on joined list data
	sysopen/syswrite	Sysopen a file, call syswrite on joined list
				data
	original write_file	write_file code from original File::Slurp
				(pre-version 9999.*)
--------------------------------------------------------------------------
These benchmarks write a scalar to a file. Use the direction option
of 'out' or 'both' and the context option is 'scalar' or 'both'.

	Key			Description/Source
	-----			--------------------------
	FS::write_file		Current F::S write_file
	FS::write_file Sref	Current F::S write_file of scalar ref of data
	print			Open a file and call print() on the scalar data
	syswrite_file		Open a file, call syswrite on scalar data
	syswrite_file_ref	Open a file, call syswrite on scalar ref of
				data
	orig_write_file		write_file code from original File::Slurp
				(pre-version 9999.*)
--------------------------------------------------------------------------
These benchmarks slurp a file into an array. Use the direction option
of 'in' or 'both' and the context option is 'list' or 'both'.

	Key				Description/Source
	-----				--------------------------
	FS::read_file			Current F::S read_file - returns array
	FS::read_file_array_ref		Current F::S read_file - returns array
					ref in any context
	FS::read_file_scalar		Current F::S read_file - returns array
					ref in scalar context
	old_sysread_file		My old fast slurp - calls sysread
	old_read_file			My old fast slurp - calls read
	orig_read_file			Original File::Slurp on CPAN 
	orig_slurp_array		Slurp.pm on CPAN - returns array
	orig_slurp_array_ref		Slurp.pm on CPAN - returns array ref
--------------------------------------------------------------------------
These benchmarks slurp a file into a scalar. Use the direction option
of 'in' or 'both' and the context option is 'scalar' or 'both'.

	Key				Description/Source
	-----				--------------------------
	FS::read_file			Current F::S read_file - returns scalar
	FS12::read_file			F::S .12 slower read_file -
					returns scalar
	FS::read_file_buf_ref		Current F::S read_file - returns
					via buf_ref argument - new buffer
	FS::read_file_buf_ref2		Current F::S read_file - returns
					via buf_ref argument - uses
					existing buffer
	FS::read_file_scalar_ref	Current F::S read_file - returns a 
					scalar ref
	old_sysread_file		My old fast slurp - calls sysread
	old_read_file			My old fast slurp - calls read
	orig_read_file			Original File::Slurp on CPAN 
	orig_slurp			Slurp.pm on CPAN
	file_contents			Very slow slurp code done by a client
	file_contents_no_OO		Same code but doesn't use FileHandle.pm 
--------------------------------------------------------------------------
LEGEND
}

sub usage {

	my( $err ) = @_ ;

	$err ||= '' ;

	die <<DIE ;
$err
Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>] 
          [--sizes=<size_list>] [--legend] [--help]

	--iterations=<iter>	Run the benchmarks this many iterations
	-i=<iter>		A positive number is iteration count,
				a negative number is minimum CPU time in
				seconds. Default is -2 (run for 2 CPU seconds).

	--direction=<dir>	Which direction to slurp: 'in', 'out' or 'both'.
	-d=<dir>		Default is 'both'.

	--context=<con>		Which context is used for slurping: 'list',
	-c=<con>		'scalar' or 'both'. Default is 'both'.

	--sizes=<size_list>	What sizes will be used in slurping (either
	-s=<size_list>		direction). This is a comma separated list of
				integers. You can use 'k' or 'm' as suffixes
				for 1024 and 1024**2. Default is '512,10k,1m'.

	--unlink		Unlink the written file before each time
	-u			a file is written

	--legend		Print out a legend of all the benchmark entries.
	--key
	-l
	-k

	--help			Print this help text
	--usage
DIE

}

__END__
Commit	Line	Data
635c7876	1	#!/usr/local/bin/perl
	2
	3	use strict ;
	4	use warnings ;
	5
	6	use Getopt::Long ;
	7	use Benchmark qw( timethese cmpthese ) ;
	8	use Carp ;
	9	use FileHandle ;
	10	use Fcntl qw( :DEFAULT :seek );
	11
	12	use File::Slurp () ;
99709852	13	use FileSlurp_12 () ;
635c7876	14
b03ff8fd	15	my $file_name = 'slurp_data' ;
8ff593f5	16	my( @lines, $text ) ;
635c7876	17
fa575d4f	18	my %opts ;
635c7876	19
	20	parse_options() ;
	21
	22	run_benchmarks() ;
	23
b03ff8fd	24	unlink $file_name ;
635c7876	25
	26	exit ;
	27
635c7876	28	sub run_benchmarks {
635c7876	29
fa575d4f	30	foreach my $size ( @{$opts{size_list}} ) {
635c7876	31
fa575d4f	32	@lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
635c7876	33	$text = join( '', @lines ) ;
fa575d4f	34
	35	my $overage = length($text) - $size ;
	36	substr( $text, -$overage, $overage, '' ) ;
	37	substr( $lines[-1], -$overage, $overage, '' ) ;
635c7876	38
8ff593f5	39	if ( $opts{slurp} ) {
8ff593f5	40
b03ff8fd	41	File::Slurp::write_file( $file_name, $text ) ;
8ff593f5	42
	43	bench_list_slurp( $size ) if $opts{list} ;
	44	bench_scalar_slurp( $size ) if $opts{scalar} ;
	45	}
635c7876	46
8ff593f5	47	if ( $opts{spew} ) {
	48
	49	bench_spew_list( $size ) if $opts{list} ;
	50	bench_scalar_spew( $size ) if $opts{scalar} ;
	51	}
635c7876	52	}
	53	}
	54
b03ff8fd	55	##########################################
99709852	56	##########################################
	57	sub bench_scalar_slurp {
	58
	59	my ( $size ) = @_ ;
	60
	61	print "\n\nReading (Slurp) into a scalar: Size = $size bytes\n\n" ;
	62
	63	my $buffer ;
	64
	65	my $result = timethese( $opts{iterations}, {
	66
	67	'FS::read_file' =>
	68	sub { my $text = File::Slurp::read_file( $file_name ) },
	69
	70	'FS12::read_file' =>
	71	sub { my $text = FileSlurp_12::read_file( $file_name ) },
	72
a878bbb4	73	'FS::read_file_buf_ref' =>
	74	sub { my $text ;
	75	File::Slurp::read_file( $file_name, buf_ref => \$text ) },
	76	'FS::read_file_buf_ref2' =>
	77	sub {
	78	File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
	79	'FS::read_file_scalar_ref' =>
	80	sub { my $text =
	81	File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
99709852	82
	83	old_sysread_file =>
	84	sub { my $text = old_sysread_file( $file_name ) },
	85
	86	old_read_file =>
	87	sub { my $text = old_read_file( $file_name ) },
	88
	89	orig_read_file =>
	90	sub { my $text = orig_read_file( $file_name ) },
	91
	92	orig_slurp =>
	93	sub { my $text = orig_slurp_scalar( $file_name ) },
	94
	95	file_contents =>
	96	sub { my $text = file_contents( $file_name ) },
	97
	98	file_contents_no_OO =>
	99	sub { my $text = file_contents_no_OO( $file_name ) },
	100	} ) ;
	101
	102	cmpthese( $result ) ;
	103	}
	104
	105	##########################################
	106
	107	sub bench_list_slurp {
	108
	109	my ( $size ) = @_ ;
	110
	111	print "\n\nReading (Slurp) into a list: Size = $size bytes\n\n" ;
	112
	113	my $result = timethese( $opts{iterations}, {
	114
	115	'FS::read_file' =>
	116	sub { my @lines = File::Slurp::read_file( $file_name ) },
	117
	118	'FS::read_file_array_ref' =>
	119	sub { my $lines_ref =
	120	File::Slurp::read_file( $file_name, array_ref => 1 ) },
	121
	122	'FS::read_file_scalar' =>
	123	sub { my $lines_ref =
	124	[ File::Slurp::read_file( $file_name ) ] },
	125
	126	old_sysread_file =>
	127	sub { my @lines = old_sysread_file( $file_name ) },
	128
	129	old_read_file =>
	130	sub { my @lines = old_read_file( $file_name ) },
	131
	132	orig_read_file =>
	133	sub { my @lines = orig_read_file( $file_name ) },
	134
	135	orig_slurp_array =>
	136	sub { my @lines = orig_slurp_array( $file_name ) },
	137
	138	orig_slurp_array_ref =>
	139	sub { my $lines_ref = orig_slurp_array( $file_name ) },
	140	} ) ;
	141
	142	cmpthese( $result ) ;
	143	}
	144
	145	######################################
146	# uri's old fast slurp
147
148	sub old_read_file {
149
150	my( $file_name ) = shift ;
151
152	local( *FH ) ;
153	open( FH, $file_name ) \|\| carp "can't open $file_name $!" ;
154
155	return <FH> if wantarray ;
156
157	my $buf ;
158
159	read( FH, $buf, -s FH ) ;
160	return $buf ;
161	}
162
163	sub old_sysread_file {
164
165	my( $file_name ) = shift ;
166
167	local( *FH ) ;
168	open( FH, $file_name ) \|\| carp "can't open $file_name $!" ;
169
170	return <FH> if wantarray ;
171
172	my $buf ;
173
174	sysread( FH, $buf, -s FH ) ;
175	return $buf ;
176	}
177
178	######################################
179	# from File::Slurp.pm on cpan
180
181	sub orig_read_file
182	{
183	my ($file) = @_;
184
185	local($/) = wantarray ? $/ : undef;
186	local(*F);
187	my $r;
188	my (@r);
189
190	open(F, "<$file") \|\| croak "open $file: $!";
191	@r = <F>;
192	close(F) \|\| croak "close $file: $!";
193
194	return $r[0] unless wantarray;
195	return @r;
196	}
197
198
199	######################################
200	# from Slurp.pm on cpan
201
202	sub orig_slurp {
203	local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
204	return <ARGV>;
205	}
206
207	sub orig_slurp_array {
208	my @array = orig_slurp( @_ );
209	return wantarray ? @array : \@array;
210	}
211
212	sub orig_slurp_scalar {
213	my $scalar = orig_slurp( @_ );
214	return $scalar;
215	}
216
217	######################################
218	# very slow slurp code used by a client
219
220	sub file_contents {
221	my $file = shift;
222	my $fh = new FileHandle $file or
223	warn("Util::file_contents:Can't open file $file"), return '';
224	return join '', <$fh>;
225	}
226
227	# same code but doesn't use FileHandle.pm
228
229	sub file_contents_no_OO {
230	my $file = shift;
231
232	local( *FH ) ;
233	open( FH, $file ) \|\| carp "can't open $file $!" ;
234
235	return join '', <FH>;
236	}
237
238	##########################################
239	##########################################
b03ff8fd	240
635c7876	241	sub bench_spew_list {
635c7876	242
8ff593f5	243	my( $size ) = @_ ;
635c7876	244
	245	print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
	246
8ff593f5	247	my $result = timethese( $opts{iterations}, {
b03ff8fd	248	'FS::write_file' => sub { unlink $file_name if $opts{unlink} ;
	249	File::Slurp::write_file( $file_name, @lines ) },
	250	'FS::write_file Aref' => sub { unlink $file_name if $opts{unlink} ;
	251	File::Slurp::write_file( $file_name, \@lines ) },
	252	'print' => sub { unlink $file_name if $opts{unlink} ;
	253	print_file( $file_name, @lines ) },
	254	'print/join' => sub { unlink $file_name if $opts{unlink} ;
	255	print_join_file( $file_name, @lines ) },
	256	'syswrite/join' => sub { unlink $file_name if $opts{unlink} ;
	257	syswrite_join_file( $file_name, @lines ) },
	258	'original write_file' => sub { unlink $file_name if $opts{unlink} ;
	259	orig_write_file( $file_name, @lines ) },
635c7876	260	} ) ;
	261
	262	cmpthese( $result ) ;
	263	}
	264
8ff593f5	265	sub print_file {
	266
	267	my( $file_name ) = shift ;
	268
8ff593f5	269	local( *FH ) ;
	270	open( FH, ">$file_name" ) \|\| carp "can't create $file_name $!" ;
	271
	272	print FH @_ ;
	273	}
	274
	275	sub print_join_file {
	276
	277	my( $file_name ) = shift ;
	278
8ff593f5	279	local( *FH ) ;
	280	open( FH, ">$file_name" ) \|\| carp "can't create $file_name $!" ;
	281
	282	print FH join( '', @_ ) ;
	283	}
	284
	285	sub syswrite_join_file {
	286
	287	my( $file_name ) = shift ;
	288
8ff593f5	289	local( *FH ) ;
	290	open( FH, ">$file_name" ) \|\| carp "can't create $file_name $!" ;
	291
	292	syswrite( FH, join( '', @_ ) ) ;
	293	}
	294
	295	sub sysopen_syswrite_join_file {
	296
	297	my( $file_name ) = shift ;
	298
8ff593f5	299	local( *FH ) ;
	300	sysopen( FH, $file_name, O_WRONLY \| O_CREAT ) \|\|
	301	carp "can't create $file_name $!" ;
	302
	303	syswrite( FH, join( '', @_ ) ) ;
	304	}
	305
	306	sub orig_write_file
	307	{
	308	my ($f, @data) = @_;
	309
8ff593f5	310	local(*F);
	311
	312	open(F, ">$f") \|\| croak "open >$f: $!";
	313	(print F @data) \|\| croak "write $f: $!";
	314	close(F) \|\| croak "close $f: $!";
	315	return 1;
	316	}
	317
b03ff8fd	318	##########################################
635c7876	319
b03ff8fd	320	sub bench_scalar_spew {
635c7876	321
b03ff8fd	322	my ( $size ) = @_ ;
635c7876	323
b03ff8fd	324	print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ;
635c7876	325
b03ff8fd	326	my $result = timethese( $opts{iterations}, {
	327	'FS::write_file' => sub { unlink $file_name if $opts{unlink} ;
	328	File::Slurp::write_file( $file_name, $text ) },
	329	'FS::write_file Sref' => sub { unlink $file_name if $opts{unlink} ;
	330	File::Slurp::write_file( $file_name, \$text ) },
	331	'print' => sub { unlink $file_name if $opts{unlink} ;
	332	print_file( $file_name, $text ) },
	333	'syswrite_file' => sub { unlink $file_name if $opts{unlink} ;
	334	syswrite_file( $file_name, $text ) },
	335	'syswrite_file_ref' => sub { unlink $file_name if $opts{unlink} ;
	336	syswrite_file_ref( $file_name, \$text ) },
	337	'orig_write_file' => sub { unlink $file_name if $opts{unlink} ;
	338	orig_write_file( $file_name, $text ) },
	339	} ) ;
635c7876	340
b03ff8fd	341	cmpthese( $result ) ;
b03ff8fd	342	}
635c7876	343
b03ff8fd	344	sub syswrite_file {
635c7876	345
b03ff8fd	346	my( $file_name, $text ) = @_ ;
635c7876	347
b03ff8fd	348	local( *FH ) ;
b03ff8fd	349	open( FH, ">$file_name" ) \|\| carp "can't create $file_name $!" ;
635c7876	350
b03ff8fd	351	syswrite( FH, $text ) ;
b03ff8fd	352	}
635c7876	353
b03ff8fd	354	sub syswrite_file_ref {
635c7876	355
b03ff8fd	356	my( $file_name, $text_ref ) = @_ ;
	357
	358	local( *FH ) ;
	359	open( FH, ">$file_name" ) \|\| carp "can't create $file_name $!" ;
	360
	361	syswrite( FH, ${$text_ref} ) ;
	362	}
	363
635c7876	364	sub parse_options {
635c7876	365
fa575d4f	366	my $result = GetOptions (\%opts, qw(
	367	iterations\|i=s
	368	direction\|d=s
	369	context\|c=s
	370	sizes\|s=s
b03ff8fd	371	unlink\|u
fa575d4f	372	legend\|key\|l\|k
	373	help\|usage
	374	) ) ;
	375
	376	usage() unless $result ;
	377
	378	usage() if $opts{help} ;
635c7876	379
fa575d4f	380	legend() if $opts{legend} ;
635c7876	381
fa575d4f	382	# set defaults
635c7876	383
fa575d4f	384	$opts{direction} \|\|= 'both' ;
	385	$opts{context} \|\|= 'both' ;
	386	$opts{iterations} \|\|= -2 ;
a878bbb4	387	$opts{sizes} \|\|= '512,10k,1m' ;
fa575d4f	388
	389	if ( $opts{direction} eq 'both' ) {
	390
635c7876	391	$opts{spew} = 1 ;
	392	$opts{slurp} = 1 ;
	393	}
fa575d4f	394	elsif ( $opts{direction} eq 'in' ) {
635c7876	395
fa575d4f	396	$opts{slurp} = 1 ;
	397
	398	}
	399	elsif ( $opts{direction} eq 'out' ) {
	400
	401	$opts{spew} = 1 ;
	402	}
	403	else {
	404
	405	usage( "Unknown direction: $opts{direction}" ) ;
	406	}
635c7876	407
fa575d4f	408	if ( $opts{context} eq 'both' ) {
fa575d4f	409
635c7876	410	$opts{list} = 1 ;
	411	$opts{scalar} = 1 ;
	412	}
fa575d4f	413	elsif ( $opts{context} eq 'scalar' ) {
635c7876	414
fa575d4f	415	$opts{scalar} = 1 ;
	416
	417	}
	418	elsif ( $opts{context} eq 'list' ) {
635c7876	419
fa575d4f	420	$opts{list} = 1 ;
	421	}
	422	else {
	423
	424	usage( "Unknown context: $opts{context}" ) ;
	425	}
	426
	427	if ( $opts{context} eq 'both' ) {
	428
	429	$opts{list} = 1 ;
	430	$opts{scalar} = 1 ;
	431	}
	432	elsif ( $opts{context} eq 'scalar' ) {
635c7876	433
fa575d4f	434	$opts{scalar} = 1 ;
	435
	436	}
	437	elsif ( $opts{context} eq 'list' ) {
	438
	439	$opts{list} = 1 ;
	440	}
	441	else {
	442
	443	usage( "Unknown context: $opts{context}" ) ;
	444	}
	445
	446	foreach my $size ( split ',', ( $opts{sizes} ) ) {
	447
	448
	449	# check for valid size and suffix. grab both.
	450
	451	usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
635c7876	452
fa575d4f	453	# handle suffix multipliers
635c7876	454
fa575d4f	455	$size = $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
	456
	457	push( @{$opts{size_list}}, $size ) ;
	458	}
	459
	460	#use Data::Dumper ;
	461	#print Dumper \%opts ;
	462	}
	463
	464	sub legend {
	465
	466	die <<'LEGEND' ;
99709852	467	--------------------------------------------------------------------------
8ff593f5	468	Legend for the Slurp Benchmark Entries
635c7876	469
8ff593f5	470	In all cases below 'FS' or 'F::S' means the current File::Slurp module
	471	is being used in the benchmark. The full name and description will say
	472	which options are being used.
99709852	473	--------------------------------------------------------------------------
8ff593f5	474	These benchmarks write a list of lines to a file. Use the direction option
8ff593f5	475	of 'out' or 'both' and the context option is 'list' or 'both'.
635c7876	476
635c7876	477	Key Description/Source
99709852	478	----- --------------------------
8ff593f5	479	FS::write_file Current F::S write_file
	480	FS::write_file Aref Current F::S write_file on array ref of data
	481	print Open a file and call print() on the list data
99709852	482	print/join Open a file and call print() on the joined list
99709852	483	data
8ff593f5	484	syswrite/join Open a file, call syswrite on joined list data
99709852	485	sysopen/syswrite Sysopen a file, call syswrite on joined list
99709852	486	data
8ff593f5	487	original write_file write_file code from original File::Slurp
8ff593f5	488	(pre-version 9999.*)
99709852	489	--------------------------------------------------------------------------
b03ff8fd	490	These benchmarks write a scalar to a file. Use the direction option
	491	of 'out' or 'both' and the context option is 'scalar' or 'both'.
	492
	493	Key Description/Source
99709852	494	----- --------------------------
b03ff8fd	495	FS::write_file Current F::S write_file
	496	FS::write_file Sref Current F::S write_file of scalar ref of data
	497	print Open a file and call print() on the scalar data
	498	syswrite_file Open a file, call syswrite on scalar data
99709852	499	syswrite_file_ref Open a file, call syswrite on scalar ref of
99709852	500	data
b03ff8fd	501	orig_write_file write_file code from original File::Slurp
b03ff8fd	502	(pre-version 9999.*)
99709852	503	--------------------------------------------------------------------------
b03ff8fd	504	These benchmarks slurp a file into an array. Use the direction option
	505	of 'in' or 'both' and the context option is 'list' or 'both'.
	506
99709852	507	Key Description/Source
	508	----- --------------------------
	509	FS::read_file Current F::S read_file - returns array
	510	FS::read_file_array_ref Current F::S read_file - returns array
	511	ref in any context
	512	FS::read_file_scalar Current F::S read_file - returns array
	513	ref in scalar context
	514	old_sysread_file My old fast slurp - calls sysread
	515	old_read_file My old fast slurp - calls read
	516	orig_read_file Original File::Slurp on CPAN
	517	orig_slurp_array Slurp.pm on CPAN - returns array
	518	orig_slurp_array_ref Slurp.pm on CPAN - returns array ref
	519	--------------------------------------------------------------------------
b03ff8fd	520	These benchmarks slurp a file into a scalar. Use the direction option
	521	of 'in' or 'both' and the context option is 'scalar' or 'both'.
	522
99709852	523	Key Description/Source
	524	----- --------------------------
	525	FS::read_file Current F::S read_file - returns scalar
	526	FS12::read_file F::S .12 slower read_file -
	527	returns scalar
	528	FS::read_file_buf_ref Current F::S read_file - returns
	529	via buf_ref argument - new buffer
	530	FS::read_file_buf_ref2 Current F::S read_file - returns
	531	via buf_ref argument - uses
	532	existing buffer
	533	FS::read_file_scalar_ref Current F::S read_file - returns a
	534	scalar ref
	535	old_sysread_file My old fast slurp - calls sysread
	536	old_read_file My old fast slurp - calls read
	537	orig_read_file Original File::Slurp on CPAN
	538	orig_slurp Slurp.pm on CPAN
	539	file_contents Very slow slurp code done by a client
	540	file_contents_no_OO Same code but doesn't use FileHandle.pm
	541	--------------------------------------------------------------------------
fa575d4f	542	LEGEND
635c7876	543	}
635c7876	544
fa575d4f	545	sub usage {
635c7876	546
fa575d4f	547	my( $err ) = @_ ;
635c7876	548
fa575d4f	549	$err \|\|= '' ;
635c7876	550
fa575d4f	551	die <<DIE ;
	552	$err
	553	Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
	554	[--sizes=<size_list>] [--legend] [--help]
635c7876	555
fa575d4f	556	--iterations=<iter> Run the benchmarks this many iterations
	557	-i=<iter> A positive number is iteration count,
	558	a negative number is minimum CPU time in
	559	seconds. Default is -2 (run for 2 CPU seconds).
635c7876	560
fa575d4f	561	--direction=<dir> Which direction to slurp: 'in', 'out' or 'both'.
fa575d4f	562	-d=<dir> Default is 'both'.
635c7876	563
fa575d4f	564	--context=<con> Which context is used for slurping: 'list',
fa575d4f	565	-c=<con> 'scalar' or 'both'. Default is 'both'.
635c7876	566
fa575d4f	567	--sizes=<size_list> What sizes will be used in slurping (either
	568	-s=<size_list> direction). This is a comma separated list of
	569	integers. You can use 'k' or 'm' as suffixes
a878bbb4	570	for 1024 and 1024**2. Default is '512,10k,1m'.
635c7876	571
b03ff8fd	572	--unlink Unlink the written file before each time
	573	-u a file is written
	574
fa575d4f	575	--legend Print out a legend of all the benchmark entries.
	576	--key
	577	-l
	578	-k
	579
	580	--help Print this help text
	581	--usage
635c7876	582	DIE
	583
	584	}
	585
635c7876	586	__END__
635c7876	587