7 use Benchmark qw( timethese cmpthese ) ;
10 use Fcntl qw( :DEFAULT :seek );
15 my $file_name = 'slurp_data' ;
30 foreach my $size ( @{$opts{size_list}} ) {
32 @lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
33 $text = join( '', @lines ) ;
35 my $overage = length($text) - $size ;
36 substr( $text, -$overage, $overage, '' ) ;
37 substr( $lines[-1], -$overage, $overage, '' ) ;
41 File::Slurp::write_file( $file_name, $text ) ;
43 bench_list_slurp( $size ) if $opts{list} ;
44 bench_scalar_slurp( $size ) if $opts{scalar} ;
49 bench_spew_list( $size ) if $opts{list} ;
50 bench_scalar_spew( $size ) if $opts{scalar} ;
55 ##########################################
56 ##########################################
57 sub bench_scalar_slurp {
61 print "\n\nReading (Slurp) into a scalar: Size = $size bytes\n\n" ;
65 my $result = timethese( $opts{iterations}, {
68 sub { my $text = File::Slurp::read_file( $file_name ) },
71 sub { my $text = FileSlurp_12::read_file( $file_name ) },
73 # 'FS::read_file_buf_ref' =>
75 # File::Slurp::read_file( $file_name, buf_ref => \$text ) },
76 # 'FS::read_file_buf_ref2' =>
78 # File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
79 # 'FS::read_file_scalar_ref' =>
81 # File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
84 sub { my $text = old_sysread_file( $file_name ) },
87 sub { my $text = old_read_file( $file_name ) },
90 sub { my $text = orig_read_file( $file_name ) },
93 sub { my $text = orig_slurp_scalar( $file_name ) },
96 sub { my $text = file_contents( $file_name ) },
98 file_contents_no_OO =>
99 sub { my $text = file_contents_no_OO( $file_name ) },
102 cmpthese( $result ) ;
105 ##########################################
107 sub bench_list_slurp {
111 print "\n\nReading (Slurp) into a list: Size = $size bytes\n\n" ;
113 my $result = timethese( $opts{iterations}, {
116 sub { my @lines = File::Slurp::read_file( $file_name ) },
118 'FS::read_file_array_ref' =>
119 sub { my $lines_ref =
120 File::Slurp::read_file( $file_name, array_ref => 1 ) },
122 'FS::read_file_scalar' =>
123 sub { my $lines_ref =
124 [ File::Slurp::read_file( $file_name ) ] },
127 sub { my @lines = old_sysread_file( $file_name ) },
130 sub { my @lines = old_read_file( $file_name ) },
133 sub { my @lines = orig_read_file( $file_name ) },
136 sub { my @lines = orig_slurp_array( $file_name ) },
138 orig_slurp_array_ref =>
139 sub { my $lines_ref = orig_slurp_array( $file_name ) },
142 cmpthese( $result ) ;
145 ######################################
146 # uri's old fast slurp
150 my( $file_name ) = shift ;
153 open( FH, $file_name ) || carp "can't open $file_name $!" ;
155 return <FH> if wantarray ;
159 read( FH, $buf, -s FH ) ;
163 sub old_sysread_file {
165 my( $file_name ) = shift ;
168 open( FH, $file_name ) || carp "can't open $file_name $!" ;
170 return <FH> if wantarray ;
174 sysread( FH, $buf, -s FH ) ;
178 ######################################
179 # from File::Slurp.pm on cpan
185 local($/) = wantarray ? $/ : undef;
190 open(F, "<$file") || croak "open $file: $!";
192 close(F) || croak "close $file: $!";
194 return $r[0] unless wantarray;
199 ######################################
200 # from Slurp.pm on cpan
203 local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
207 sub orig_slurp_array {
208 my @array = orig_slurp( @_ );
209 return wantarray ? @array : \@array;
212 sub orig_slurp_scalar {
213 my $scalar = orig_slurp( @_ );
217 ######################################
218 # very slow slurp code used by a client
222 my $fh = new FileHandle $file or
223 warn("Util::file_contents:Can't open file $file"), return '';
224 return join '', <$fh>;
227 # same code but doesn't use FileHandle.pm
229 sub file_contents_no_OO {
233 open( FH, $file ) || carp "can't open $file $!" ;
235 return join '', <FH>;
238 ##########################################
239 ##########################################
241 sub bench_spew_list {
245 print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
247 my $result = timethese( $opts{iterations}, {
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 ) },
262 cmpthese( $result ) ;
267 my( $file_name ) = shift ;
270 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
275 sub print_join_file {
277 my( $file_name ) = shift ;
280 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
282 print FH join( '', @_ ) ;
285 sub syswrite_join_file {
287 my( $file_name ) = shift ;
290 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
292 syswrite( FH, join( '', @_ ) ) ;
295 sub sysopen_syswrite_join_file {
297 my( $file_name ) = shift ;
300 sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
301 carp "can't create $file_name $!" ;
303 syswrite( FH, join( '', @_ ) ) ;
312 open(F, ">$f") || croak "open >$f: $!";
313 (print F @data) || croak "write $f: $!";
314 close(F) || croak "close $f: $!";
318 ##########################################
320 sub bench_scalar_spew {
324 print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ;
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 ) },
341 cmpthese( $result ) ;
346 my( $file_name, $text ) = @_ ;
349 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
351 syswrite( FH, $text ) ;
354 sub syswrite_file_ref {
356 my( $file_name, $text_ref ) = @_ ;
359 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
361 syswrite( FH, ${$text_ref} ) ;
366 my $result = GetOptions (\%opts, qw(
376 usage() unless $result ;
378 usage() if $opts{help} ;
380 legend() if $opts{legend} ;
384 $opts{direction} ||= 'both' ;
385 $opts{context} ||= 'both' ;
386 $opts{iterations} ||= -2 ;
387 $opts{sizes} ||= '500,10k,1m' ;
389 if ( $opts{direction} eq 'both' ) {
394 elsif ( $opts{direction} eq 'in' ) {
399 elsif ( $opts{direction} eq 'out' ) {
405 usage( "Unknown direction: $opts{direction}" ) ;
408 if ( $opts{context} eq 'both' ) {
413 elsif ( $opts{context} eq 'scalar' ) {
418 elsif ( $opts{context} eq 'list' ) {
424 usage( "Unknown context: $opts{context}" ) ;
427 if ( $opts{context} eq 'both' ) {
432 elsif ( $opts{context} eq 'scalar' ) {
437 elsif ( $opts{context} eq 'list' ) {
443 usage( "Unknown context: $opts{context}" ) ;
446 foreach my $size ( split ',', ( $opts{sizes} ) ) {
449 # check for valid size and suffix. grab both.
451 usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
453 # handle suffix multipliers
455 $size = $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
457 push( @{$opts{size_list}}, $size ) ;
461 #print Dumper \%opts ;
467 --------------------------------------------------------------------------
468 Legend for the Slurp Benchmark Entries
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.
473 --------------------------------------------------------------------------
474 These benchmarks write a list of lines to a file. Use the direction option
475 of 'out' or 'both' and the context option is 'list' or 'both'.
477 Key Description/Source
478 ----- --------------------------
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
482 print/join Open a file and call print() on the joined list
484 syswrite/join Open a file, call syswrite on joined list data
485 sysopen/syswrite Sysopen a file, call syswrite on joined list
487 original write_file write_file code from original File::Slurp
489 --------------------------------------------------------------------------
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'.
493 Key Description/Source
494 ----- --------------------------
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
499 syswrite_file_ref Open a file, call syswrite on scalar ref of
501 orig_write_file write_file code from original File::Slurp
503 --------------------------------------------------------------------------
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'.
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
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 --------------------------------------------------------------------------
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'.
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 -
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
533 FS::read_file_scalar_ref Current F::S read_file - returns a
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 --------------------------------------------------------------------------
553 Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
554 [--sizes=<size_list>] [--legend] [--help]
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).
561 --direction=<dir> Which direction to slurp: 'in', 'out' or 'both'.
562 -d=<dir> Default is 'both'.
564 --context=<con> Which context is used for slurping: 'list',
565 -c=<con> 'scalar' or 'both'. Default is 'both'.
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
570 for 1024 and 1024**2. Default is '500,1k,1m'.
572 --unlink Unlink the written file before each time
575 --legend Print out a legend of all the benchmark entries.
580 --help Print this help text