[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 () ;

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_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 bench_scalar_slurp {

# 	my ( $size ) = @_ ;

# 	print "\n\nScalar Slurp of $size bytes\n\n" ;

# 	my $buffer ;

# 	my $result = timethese( $dur, {

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

# 		new_buf_ref =>
# 	    		sub { my $text ;
# 			   File::Slurp::read_file( $file_name, buf_ref => \$text ) },
# 		new_buf_ref2 =>
# 	    		sub { 
# 			   File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
# 		new_scalar_ref =>
# 	    		sub { my $text =
# 			    File::Slurp::read_file( $file_name, scalar_ref => 1 ) },

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

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

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

# 		'Slurp.pm scalar' =>
# 			sub { my $text = 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\nList Slurp of $size file\n\n" ;

# 	my $result = timethese( $dur, {

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

# 		new_array_ref =>
# 	    		sub { my $lines_ref =
# 			     File::Slurp::read_file( $file_name, array_ref => 1 ) },

# 		new_in_anon_array =>
# 	    		sub { my $lines_ref =
# 			     [ File::Slurp::read_file( $file_name ) ] },

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

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

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

# 		'Slurp.pm to array' =>
# 			sub { my @lines = slurp_array( $file_name ) },

# 		orig_slurp_to_array_ref =>
# 			sub { my $lines_ref = orig_slurp_to_array( $file_name ) },
# 	} ) ;

# 	cmpthese( $result ) ;
# }


###########################
# write file benchmark subs
###########################


#######################
# top level subs for script

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

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} ||= '500,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'.

FIX THIS

	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 slurp a file into a scalar. Use the direction option
of 'in' or 'both' and the context option is 'scalar' or 'both'.

FIX THIS

	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.*)

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 '500,1k,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__


sub bench_scalar_slurp {

	my ( $size ) = @_ ;

	print "\n\nScalar Slurp of $size file\n\n" ;

	my $buffer ;

	my $result = timethese( $dur, {

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

		new_buf_ref =>
	    		sub { my $text ;
			   File::Slurp::read_file( $file_name, buf_ref => \$text ) },
		new_buf_ref2 =>
	    		sub { 
			   File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
		new_scalar_ref =>
	    		sub { my $text =
			    File::Slurp::read_file( $file_name, scalar_ref => 1 ) },

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

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

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

		orig_slurp =>
			sub { my $text = orig_slurp_to_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\nList Slurp of $size file\n\n" ;

	my $result = timethese( $dur, {

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

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

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

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

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

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

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

		orig_slurp_to_array_ref =>
			sub { my $lines_ref = orig_slurp_to_array( $file_name ) },
	} ) ;

	cmpthese( $result ) ;
}

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

sub 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 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 slurp { 
    local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ ); 
    return <ARGV>;
}

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

sub slurp_scalar {
    my $scalar = 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>;
}

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