7 use Benchmark qw( timethese cmpthese ) ;
10 use Fcntl qw( :DEFAULT :seek );
14 my $file_name = 'slurp_data' ;
29 foreach my $size ( @{$opts{size_list}} ) {
31 @lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
32 $text = join( '', @lines ) ;
34 my $overage = length($text) - $size ;
35 substr( $text, -$overage, $overage, '' ) ;
36 substr( $lines[-1], -$overage, $overage, '' ) ;
40 File::Slurp::write_file( $file_name, $text ) ;
42 bench_list_slurp( $size ) if $opts{list} ;
43 bench_scalar_slurp( $size ) if $opts{scalar} ;
48 bench_spew_list( $size ) if $opts{list} ;
49 bench_scalar_spew( $size ) if $opts{scalar} ;
54 ##########################################
60 print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
62 my $result = timethese( $opts{iterations}, {
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 ) },
82 my( $file_name ) = shift ;
85 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
92 my( $file_name ) = shift ;
95 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
97 print FH join( '', @_ ) ;
100 sub syswrite_join_file {
102 my( $file_name ) = shift ;
105 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
107 syswrite( FH, join( '', @_ ) ) ;
110 sub sysopen_syswrite_join_file {
112 my( $file_name ) = shift ;
115 sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
116 carp "can't create $file_name $!" ;
118 syswrite( FH, join( '', @_ ) ) ;
127 open(F, ">$f") || croak "open >$f: $!";
128 (print F @data) || croak "write $f: $!";
129 close(F) || croak "close $f: $!";
133 ##########################################
135 sub bench_scalar_spew {
139 print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ;
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 ) },
156 cmpthese( $result ) ;
161 my( $file_name, $text ) = @_ ;
164 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
166 syswrite( FH, $text ) ;
169 sub syswrite_file_ref {
171 my( $file_name, $text_ref ) = @_ ;
174 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
176 syswrite( FH, ${$text_ref} ) ;
179 #############################################
182 # sub bench_scalar_slurp {
184 # my ( $size ) = @_ ;
186 # print "\n\nScalar Slurp of $size bytes\n\n" ;
190 # my $result = timethese( $dur, {
193 # sub { my $text = File::Slurp::read_file( $file_name ) },
197 # File::Slurp::read_file( $file_name, buf_ref => \$text ) },
200 # File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
203 # File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
206 # sub { my $text = read_file( $file_name ) },
209 # sub { my $text = sysread_file( $file_name ) },
212 # sub { my $text = orig_read_file( $file_name ) },
214 # 'Slurp.pm scalar' =>
215 # sub { my $text = slurp_scalar( $file_name ) },
218 # sub { my $text = file_contents( $file_name ) },
220 # file_contents_no_OO =>
221 # sub { my $text = file_contents_no_OO( $file_name ) },
224 # cmpthese( $result ) ;
227 # sub bench_list_slurp {
229 # my ( $size ) = @_ ;
231 # print "\n\nList Slurp of $size file\n\n" ;
233 # my $result = timethese( $dur, {
236 # sub { my @lines = File::Slurp::read_file( $file_name ) },
239 # sub { my $lines_ref =
240 # File::Slurp::read_file( $file_name, array_ref => 1 ) },
242 # new_in_anon_array =>
243 # sub { my $lines_ref =
244 # [ File::Slurp::read_file( $file_name ) ] },
247 # sub { my @lines = read_file( $file_name ) },
250 # sub { my @lines = sysread_file( $file_name ) },
253 # sub { my @lines = orig_read_file( $file_name ) },
255 # 'Slurp.pm to array' =>
256 # sub { my @lines = slurp_array( $file_name ) },
258 # orig_slurp_to_array_ref =>
259 # sub { my $lines_ref = orig_slurp_to_array( $file_name ) },
262 # cmpthese( $result ) ;
266 ###########################
267 # write file benchmark subs
268 ###########################
272 #######################
273 # top level subs for script
275 #######################
279 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 ;
380 Legend for the Slurp Benchmark Entries
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.
386 These benchmarks write a list of lines to a file. Use the direction option
387 of 'out' or 'both' and the context option is 'list' or 'both'.
389 Key Description/Source
390 --- ------------------
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
396 syswrite/join Open a file, call syswrite on joined list data
397 sysopen/syswrite Sysopen a file, call syswrite on joined
399 original write_file write_file code from original File::Slurp
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'.
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
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'.
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
427 syswrite/join Open a file, call syswrite on joined list data
428 sysopen/syswrite Sysopen a file, call syswrite on joined
430 original write_file write_file code from original File::Slurp
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'.
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
445 syswrite/join Open a file, call syswrite on joined list data
446 sysopen/syswrite Sysopen a file, call syswrite on joined
448 original write_file write_file code from original File::Slurp
462 Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
463 [--sizes=<size_list>] [--legend] [--help]
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).
470 --direction=<dir> Which direction to slurp: 'in', 'out' or 'both'.
471 -d=<dir> Default is 'both'.
473 --context=<con> Which context is used for slurping: 'list',
474 -c=<con> 'scalar' or 'both'. Default is 'both'.
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'.
481 --unlink Unlink the written file before each time
484 --legend Print out a legend of all the benchmark entries.
489 --help Print this help text
499 sub bench_scalar_slurp {
503 print "\n\nScalar Slurp of $size file\n\n" ;
507 my $result = timethese( $dur, {
510 sub { my $text = File::Slurp::read_file( $file_name ) },
514 File::Slurp::read_file( $file_name, buf_ref => \$text ) },
517 File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
520 File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
523 sub { my $text = read_file( $file_name ) },
526 sub { my $text = sysread_file( $file_name ) },
529 sub { my $text = orig_read_file( $file_name ) },
532 sub { my $text = orig_slurp_to_scalar( $file_name ) },
535 sub { my $text = file_contents( $file_name ) },
537 file_contents_no_OO =>
538 sub { my $text = file_contents_no_OO( $file_name ) },
541 cmpthese( $result ) ;
544 sub bench_list_slurp {
548 print "\n\nList Slurp of $size file\n\n" ;
550 my $result = timethese( $dur, {
553 sub { my @lines = File::Slurp::read_file( $file_name ) },
556 sub { my $lines_ref =
557 File::Slurp::read_file( $file_name, array_ref => 1 ) },
560 sub { my $lines_ref =
561 [ File::Slurp::read_file( $file_name ) ] },
564 sub { my @lines = read_file( $file_name ) },
567 sub { my @lines = sysread_file( $file_name ) },
570 sub { my @lines = orig_read_file( $file_name ) },
572 orig_slurp_to_array =>
573 sub { my @lines = orig_slurp_to_array( $file_name ) },
575 orig_slurp_to_array_ref =>
576 sub { my $lines_ref = orig_slurp_to_array( $file_name ) },
579 cmpthese( $result ) ;
582 ######################################
583 # uri's old fast slurp
587 my( $file_name ) = shift ;
590 open( FH, $file_name ) || carp "can't open $file_name $!" ;
592 return <FH> if wantarray ;
596 read( FH, $buf, -s FH ) ;
602 my( $file_name ) = shift ;
605 open( FH, $file_name ) || carp "can't open $file_name $!" ;
607 return <FH> if wantarray ;
611 sysread( FH, $buf, -s FH ) ;
615 ######################################
616 # from File::Slurp.pm on cpan
622 local($/) = wantarray ? $/ : undef;
627 open(F, "<$file") || croak "open $file: $!";
629 close(F) || croak "close $file: $!";
631 return $r[0] unless wantarray;
636 ######################################
637 # from Slurp.pm on cpan
640 local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
645 my @array = slurp( @_ );
646 return wantarray ? @array : \@array;
650 my $scalar = slurp( @_ );
654 ######################################
655 # very slow slurp code used by a client
659 my $fh = new FileHandle $file or
660 warn("Util::file_contents:Can't open file $file"), return '';
661 return join '', <$fh>;
664 # same code but doesn't use FileHandle.pm
666 sub file_contents_no_OO {
670 open( FH, $file ) || carp "can't open $file $!" ;
672 return join '', <FH>;
675 ##########################