summaryrefslogtreecommitdiff
path: root/extras/slurp_bench.pl
diff options
context:
space:
mode:
Diffstat (limited to 'extras/slurp_bench.pl')
-rwxr-xr-xextras/slurp_bench.pl587
1 files changed, 587 insertions, 0 deletions
diff --git a/extras/slurp_bench.pl b/extras/slurp_bench.pl
new file mode 100755
index 0000000..68eb5fd
--- /dev/null
+++ b/extras/slurp_bench.pl
@@ -0,0 +1,587 @@
+#!/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__
+
View Lorry Controller Status