X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=urisagit%2FPerl-Docs.git;a=blobdiff_plain;f=extras%2Fslurp_bench.pl;fp=extras%2Fslurp_bench.pl;h=0000000000000000000000000000000000000000;hp=68eb5fd443a55063e4047df1bb13adb6e9b51d27;hb=47f1263f57592cfd836dee694c227575bc9cde46;hpb=cf83821d2b095a464d353ea98e41bfa8b262caef diff --git a/extras/slurp_bench.pl b/extras/slurp_bench.pl deleted file mode 100755 index 68eb5fd..0000000 --- a/extras/slurp_bench.pl +++ /dev/null @@ -1,587 +0,0 @@ -#!/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 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 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 = ; - 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 ; -} - -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 '', ; -} - -########################################## -########################################## - -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 <] [--direction=] [--context=] - [--sizes=] [--legend] [--help] - - --iterations= Run the benchmarks this many iterations - -i= A positive number is iteration count, - a negative number is minimum CPU time in - seconds. Default is -2 (run for 2 CPU seconds). - - --direction= Which direction to slurp: 'in', 'out' or 'both'. - -d= Default is 'both'. - - --context= Which context is used for slurping: 'list', - -c= 'scalar' or 'both'. Default is 'both'. - - --sizes= What sizes will be used in slurping (either - -s= 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__ -