7 use Benchmark qw( timethese cmpthese ) ;
10 use Fcntl qw( :DEFAULT :seek );
14 my $file = 'slurp_data' ;
26 my( @lines, $text, $size ) ;
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, '' ) ;
39 File::Slurp::write_file( $file, $text ) ;
41 # bench_list_slurp( $size ) if $opts{list} && $opts{slurp} ;
42 # bench_scalar_slurp( $size ) if $opts{scalar} && $opts{slurp} ;
44 # bench_scalar_spew( $size ) if $opts{scalar} && $opts{spew} ;
50 return unless $opts{list} && $opts{spew} ;
52 print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
54 my $result = timethese( $opts{duration}, {
57 sub { File::Slurp::write_file( $file, @lines ) },
60 sub { print_file( $file, @lines ) },
63 sub { print_join_file( $file, @lines ) },
66 sub { syswrite_join_file( $file, @lines ) },
68 'original write_file' =>
69 sub { orig_write_file( $file, @lines ) },
76 # sub bench_scalar_spew {
80 # print "\n\nScalar Spew of $size file\n\n" ;
82 # my $result = timethese( $dur, {
85 # sub { File::Slurp::write_file( $file, $text ) },
88 # sub { File::Slurp::write_file( $file, \$text ) },
91 # sub { print_file( $file, $text ) },
94 # sub { print_join_file( $file, $text ) },
97 # sub { syswrite_file( $file, $text ) },
100 # sub { syswrite_file2( $file, $text ) },
103 # sub { orig_write_file( $file, $text ) },
107 # cmpthese( $result ) ;
110 # sub bench_scalar_slurp {
112 # my ( $size ) = @_ ;
114 # print "\n\nScalar Slurp of $size file\n\n" ;
118 # my $result = timethese( $dur, {
121 # sub { my $text = File::Slurp::read_file( $file ) },
125 # File::Slurp::read_file( $file, buf_ref => \$text ) },
128 # File::Slurp::read_file( $file, buf_ref => \$buffer ) },
131 # File::Slurp::read_file( $file, scalar_ref => 1 ) },
134 # sub { my $text = read_file( $file ) },
137 # sub { my $text = sysread_file( $file ) },
140 # sub { my $text = orig_read_file( $file ) },
142 # 'Slurp.pm scalar' =>
143 # sub { my $text = slurp_scalar( $file ) },
146 # sub { my $text = file_contents( $file ) },
148 # file_contents_no_OO =>
149 # sub { my $text = file_contents_no_OO( $file ) },
152 # cmpthese( $result ) ;
155 # sub bench_list_slurp {
157 # my ( $size ) = @_ ;
159 # print "\n\nList Slurp of $size file\n\n" ;
161 # my $result = timethese( $dur, {
164 # sub { my @lines = File::Slurp::read_file( $file ) },
167 # sub { my $lines_ref =
168 # File::Slurp::read_file( $file, array_ref => 1 ) },
170 # new_in_anon_array =>
171 # sub { my $lines_ref =
172 # [ File::Slurp::read_file( $file ) ] },
175 # sub { my @lines = read_file( $file ) },
178 # sub { my @lines = sysread_file( $file ) },
181 # sub { my @lines = orig_read_file( $file ) },
183 # 'Slurp.pm to array' =>
184 # sub { my @lines = slurp_array( $file ) },
186 # orig_slurp_to_array_ref =>
187 # sub { my $lines_ref = orig_slurp_to_array( $file ) },
190 # cmpthese( $result ) ;
194 ###########################
195 # write file benchmark subs
196 ###########################
201 my( $file_name ) = shift ;
205 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
212 my( $file_name ) = shift ;
216 my $mode = ( -e $file_name ) ? '<' : '>' ;
218 open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
223 sub print_join_file {
225 my( $file_name ) = shift ;
229 my $mode = ( -e $file_name ) ? '<' : '>' ;
231 open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
233 print FH join( '', @_ ) ;
237 sub syswrite_join_file {
239 my( $file_name ) = shift ;
243 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
245 syswrite( FH, join( '', @_ ) ) ;
248 sub sysopen_syswrite_join_file {
250 my( $file_name ) = shift ;
254 sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
255 carp "can't create $file_name $!" ;
257 syswrite( FH, join( '', @_ ) ) ;
266 open(F, ">$f") || croak "open >$f: $!";
267 (print F @data) || croak "write $f: $!";
268 close(F) || croak "close $f: $!";
273 #######################
274 # top level subs for script
276 #######################
280 my $result = GetOptions (\%opts, qw(
289 usage() unless $result ;
291 usage() if $opts{help} ;
293 legend() if $opts{legend} ;
297 $opts{direction} ||= 'both' ;
298 $opts{context} ||= 'both' ;
299 $opts{iterations} ||= -2 ;
300 $opts{sizes} ||= '500,10k,1m' ;
302 if ( $opts{direction} eq 'both' ) {
307 elsif ( $opts{direction} eq 'in' ) {
312 elsif ( $opts{direction} eq 'out' ) {
318 usage( "Unknown direction: $opts{direction}" ) ;
321 if ( $opts{context} eq 'both' ) {
326 elsif ( $opts{context} eq 'scalar' ) {
331 elsif ( $opts{context} eq 'list' ) {
337 usage( "Unknown context: $opts{context}" ) ;
340 if ( $opts{context} eq 'both' ) {
345 elsif ( $opts{context} eq 'scalar' ) {
350 elsif ( $opts{context} eq 'list' ) {
356 usage( "Unknown context: $opts{context}" ) ;
359 foreach my $size ( split ',', ( $opts{sizes} ) ) {
362 # check for valid size and suffix. grab both.
364 usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
366 # handle suffix multipliers
368 $size = $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
370 push( @{$opts{size_list}}, $size ) ;
374 #print Dumper \%opts ;
381 Key to Slurp/Spew Benchmarks
384 Write a list of lines to a file
386 Key Description/Source
387 --- ------------------
389 FS:write_file Current File::Slurp::write_file
390 FS:write_file_ref Current File::Slurp::write_file (scalar ref)
391 print Open a file and call print()
392 syswrite/join Open a file, call syswrite on joined lines
393 sysopen/syswrite Sysopen a file, call syswrite on joined lines
394 original write_file Original (pre 9999.*) File::Slurp::write_file
408 Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
409 [--sizes=<size_list>] [--legend] [--help]
411 --iterations=<iter> Run the benchmarks this many iterations
412 -i=<iter> A positive number is iteration count,
413 a negative number is minimum CPU time in
414 seconds. Default is -2 (run for 2 CPU seconds).
416 --direction=<dir> Which direction to slurp: 'in', 'out' or 'both'.
417 -d=<dir> Default is 'both'.
419 --context=<con> Which context is used for slurping: 'list',
420 -c=<con> 'scalar' or 'both'. Default is 'both'.
422 --sizes=<size_list> What sizes will be used in slurping (either
423 -s=<size_list> direction). This is a comma separated list of
424 integers. You can use 'k' or 'm' as suffixes
425 for 1024 and 1024**2. Default is '500,1k,1m'.
427 --legend Print out a legend of all the benchmark entries.
432 --help Print this help text
441 sub bench_scalar_spew {
445 print "\n\nScalar Spew of $size file\n\n" ;
447 my $result = timethese( $dur, {
450 sub { File::Slurp::write_file( $file, $text ) },
453 sub { File::Slurp::write_file( $file, \$text ) },
456 sub { print_file( $file, $text ) },
459 sub { print_join_file( $file, $text ) },
462 sub { syswrite_file( $file, $text ) },
465 sub { syswrite_file2( $file, $text ) },
468 sub { orig_write_file( $file, $text ) },
472 cmpthese( $result ) ;
475 sub bench_scalar_slurp {
479 print "\n\nScalar Slurp of $size file\n\n" ;
483 my $result = timethese( $dur, {
486 sub { my $text = File::Slurp::read_file( $file ) },
490 File::Slurp::read_file( $file, buf_ref => \$text ) },
493 File::Slurp::read_file( $file, buf_ref => \$buffer ) },
496 File::Slurp::read_file( $file, scalar_ref => 1 ) },
499 sub { my $text = read_file( $file ) },
502 sub { my $text = sysread_file( $file ) },
505 sub { my $text = orig_read_file( $file ) },
508 sub { my $text = orig_slurp_to_scalar( $file ) },
511 sub { my $text = file_contents( $file ) },
513 file_contents_no_OO =>
514 sub { my $text = file_contents_no_OO( $file ) },
517 cmpthese( $result ) ;
520 sub bench_list_slurp {
524 print "\n\nList Slurp of $size file\n\n" ;
526 my $result = timethese( $dur, {
529 sub { my @lines = File::Slurp::read_file( $file ) },
532 sub { my $lines_ref =
533 File::Slurp::read_file( $file, array_ref => 1 ) },
536 sub { my $lines_ref =
537 [ File::Slurp::read_file( $file ) ] },
540 sub { my @lines = read_file( $file ) },
543 sub { my @lines = sysread_file( $file ) },
546 sub { my @lines = orig_read_file( $file ) },
548 orig_slurp_to_array =>
549 sub { my @lines = orig_slurp_to_array( $file ) },
551 orig_slurp_to_array_ref =>
552 sub { my $lines_ref = orig_slurp_to_array( $file ) },
555 cmpthese( $result ) ;
558 ######################################
559 # uri's old fast slurp
563 my( $file_name ) = shift ;
566 open( FH, $file_name ) || carp "can't open $file_name $!" ;
568 return <FH> if wantarray ;
572 read( FH, $buf, -s FH ) ;
578 my( $file_name ) = shift ;
581 open( FH, $file_name ) || carp "can't open $file_name $!" ;
583 return <FH> if wantarray ;
587 sysread( FH, $buf, -s FH ) ;
591 ######################################
592 # from File::Slurp.pm on cpan
598 local($/) = wantarray ? $/ : undef;
603 open(F, "<$file") || croak "open $file: $!";
605 close(F) || croak "close $file: $!";
607 return $r[0] unless wantarray;
612 ######################################
613 # from Slurp.pm on cpan
616 local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
621 my @array = slurp( @_ );
622 return wantarray ? @array : \@array;
626 my $scalar = slurp( @_ );
630 ######################################
631 # very slow slurp code used by a client
635 my $fh = new FileHandle $file or
636 warn("Util::file_contents:Can't open file $file"), return '';
637 return join '', <$fh>;
640 # same code but doesn't use FileHandle.pm
642 sub file_contents_no_OO {
646 open( FH, $file ) || carp "can't open $file $!" ;
648 return join '', <FH>;
651 ##########################