7 use Benchmark qw( timethese cmpthese ) ;
10 use Fcntl qw( :DEFAULT :seek );
14 my $file = '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, $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} ;
58 print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
60 my $result = timethese( $opts{iterations}, {
62 sub { File::Slurp::write_file( $file, @lines ) },
63 'FS::write_file Aref' =>
64 sub { File::Slurp::write_file( $file, \@lines ) },
66 sub { print_file( $file, @lines ) },
68 sub { print_join_file( $file, @lines ) },
70 sub { syswrite_join_file( $file, @lines ) },
71 'original write_file' =>
72 sub { orig_write_file( $file, @lines ) },
80 my( $file_name ) = shift ;
85 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
92 my( $file_name ) = shift ;
97 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
99 print FH join( '', @_ ) ;
102 sub syswrite_join_file {
104 my( $file_name ) = shift ;
109 open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
111 syswrite( FH, join( '', @_ ) ) ;
114 sub sysopen_syswrite_join_file {
116 my( $file_name ) = shift ;
121 sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
122 carp "can't create $file_name $!" ;
124 syswrite( FH, join( '', @_ ) ) ;
135 open(F, ">$f") || croak "open >$f: $!";
136 (print F @data) || croak "write $f: $!";
137 close(F) || croak "close $f: $!";
141 # sub bench_scalar_spew {
143 # my ( $size ) = @_ ;
145 # print "\n\nScalar Spew of $size file\n\n" ;
147 # my $result = timethese( $dur, {
150 # sub { File::Slurp::write_file( $file, $text ) },
153 # sub { File::Slurp::write_file( $file, \$text ) },
156 # sub { print_file( $file, $text ) },
159 # sub { print_join_file( $file, $text ) },
162 # sub { syswrite_file( $file, $text ) },
165 # sub { syswrite_file2( $file, $text ) },
168 # sub { orig_write_file( $file, $text ) },
172 # cmpthese( $result ) ;
175 # sub bench_scalar_slurp {
177 # my ( $size ) = @_ ;
179 # print "\n\nScalar Slurp of $size file\n\n" ;
183 # my $result = timethese( $dur, {
186 # sub { my $text = File::Slurp::read_file( $file ) },
190 # File::Slurp::read_file( $file, buf_ref => \$text ) },
193 # File::Slurp::read_file( $file, buf_ref => \$buffer ) },
196 # File::Slurp::read_file( $file, scalar_ref => 1 ) },
199 # sub { my $text = read_file( $file ) },
202 # sub { my $text = sysread_file( $file ) },
205 # sub { my $text = orig_read_file( $file ) },
207 # 'Slurp.pm scalar' =>
208 # sub { my $text = slurp_scalar( $file ) },
211 # sub { my $text = file_contents( $file ) },
213 # file_contents_no_OO =>
214 # sub { my $text = file_contents_no_OO( $file ) },
217 # cmpthese( $result ) ;
220 # sub bench_list_slurp {
222 # my ( $size ) = @_ ;
224 # print "\n\nList Slurp of $size file\n\n" ;
226 # my $result = timethese( $dur, {
229 # sub { my @lines = File::Slurp::read_file( $file ) },
232 # sub { my $lines_ref =
233 # File::Slurp::read_file( $file, array_ref => 1 ) },
235 # new_in_anon_array =>
236 # sub { my $lines_ref =
237 # [ File::Slurp::read_file( $file ) ] },
240 # sub { my @lines = read_file( $file ) },
243 # sub { my @lines = sysread_file( $file ) },
246 # sub { my @lines = orig_read_file( $file ) },
248 # 'Slurp.pm to array' =>
249 # sub { my @lines = slurp_array( $file ) },
251 # orig_slurp_to_array_ref =>
252 # sub { my $lines_ref = orig_slurp_to_array( $file ) },
255 # cmpthese( $result ) ;
259 ###########################
260 # write file benchmark subs
261 ###########################
265 #######################
266 # top level subs for script
268 #######################
272 my $result = GetOptions (\%opts, qw(
281 usage() unless $result ;
283 usage() if $opts{help} ;
285 legend() if $opts{legend} ;
289 $opts{direction} ||= 'both' ;
290 $opts{context} ||= 'both' ;
291 $opts{iterations} ||= -2 ;
292 $opts{sizes} ||= '500,10k,1m' ;
294 if ( $opts{direction} eq 'both' ) {
299 elsif ( $opts{direction} eq 'in' ) {
304 elsif ( $opts{direction} eq 'out' ) {
310 usage( "Unknown direction: $opts{direction}" ) ;
313 if ( $opts{context} eq 'both' ) {
318 elsif ( $opts{context} eq 'scalar' ) {
323 elsif ( $opts{context} eq 'list' ) {
329 usage( "Unknown context: $opts{context}" ) ;
332 if ( $opts{context} eq 'both' ) {
337 elsif ( $opts{context} eq 'scalar' ) {
342 elsif ( $opts{context} eq 'list' ) {
348 usage( "Unknown context: $opts{context}" ) ;
351 foreach my $size ( split ',', ( $opts{sizes} ) ) {
354 # check for valid size and suffix. grab both.
356 usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
358 # handle suffix multipliers
360 $size = $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
362 push( @{$opts{size_list}}, $size ) ;
366 #print Dumper \%opts ;
372 Legend for the Slurp Benchmark Entries
374 In all cases below 'FS' or 'F::S' means the current File::Slurp module
375 is being used in the benchmark. The full name and description will say
376 which options are being used.
378 These benchmarks write a list of lines to a file. Use the direction option
379 of 'out' or 'both' and the context option is 'list' or 'both'.
381 Key Description/Source
382 --- ------------------
383 FS::write_file Current F::S write_file
384 FS::write_file Aref Current F::S write_file on array ref of data
385 print Open a file and call print() on the list data
386 print/join Open a file and call print() on the joined
388 syswrite/join Open a file, call syswrite on joined list data
389 sysopen/syswrite Sysopen a file, call syswrite on joined
391 original write_file write_file code from original File::Slurp
405 Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
406 [--sizes=<size_list>] [--legend] [--help]
408 --iterations=<iter> Run the benchmarks this many iterations
409 -i=<iter> A positive number is iteration count,
410 a negative number is minimum CPU time in
411 seconds. Default is -2 (run for 2 CPU seconds).
413 --direction=<dir> Which direction to slurp: 'in', 'out' or 'both'.
414 -d=<dir> Default is 'both'.
416 --context=<con> Which context is used for slurping: 'list',
417 -c=<con> 'scalar' or 'both'. Default is 'both'.
419 --sizes=<size_list> What sizes will be used in slurping (either
420 -s=<size_list> direction). This is a comma separated list of
421 integers. You can use 'k' or 'm' as suffixes
422 for 1024 and 1024**2. Default is '500,1k,1m'.
424 --legend Print out a legend of all the benchmark entries.
429 --help Print this help text
438 sub bench_scalar_spew {
442 print "\n\nScalar Spew of $size file\n\n" ;
444 my $result = timethese( $dur, {
447 sub { File::Slurp::write_file( $file, $text ) },
450 sub { File::Slurp::write_file( $file, \$text ) },
453 sub { print_file( $file, $text ) },
456 sub { print_join_file( $file, $text ) },
459 sub { syswrite_file( $file, $text ) },
462 sub { syswrite_file2( $file, $text ) },
465 sub { orig_write_file( $file, $text ) },
469 cmpthese( $result ) ;
472 sub bench_scalar_slurp {
476 print "\n\nScalar Slurp of $size file\n\n" ;
480 my $result = timethese( $dur, {
483 sub { my $text = File::Slurp::read_file( $file ) },
487 File::Slurp::read_file( $file, buf_ref => \$text ) },
490 File::Slurp::read_file( $file, buf_ref => \$buffer ) },
493 File::Slurp::read_file( $file, scalar_ref => 1 ) },
496 sub { my $text = read_file( $file ) },
499 sub { my $text = sysread_file( $file ) },
502 sub { my $text = orig_read_file( $file ) },
505 sub { my $text = orig_slurp_to_scalar( $file ) },
508 sub { my $text = file_contents( $file ) },
510 file_contents_no_OO =>
511 sub { my $text = file_contents_no_OO( $file ) },
514 cmpthese( $result ) ;
517 sub bench_list_slurp {
521 print "\n\nList Slurp of $size file\n\n" ;
523 my $result = timethese( $dur, {
526 sub { my @lines = File::Slurp::read_file( $file ) },
529 sub { my $lines_ref =
530 File::Slurp::read_file( $file, array_ref => 1 ) },
533 sub { my $lines_ref =
534 [ File::Slurp::read_file( $file ) ] },
537 sub { my @lines = read_file( $file ) },
540 sub { my @lines = sysread_file( $file ) },
543 sub { my @lines = orig_read_file( $file ) },
545 orig_slurp_to_array =>
546 sub { my @lines = orig_slurp_to_array( $file ) },
548 orig_slurp_to_array_ref =>
549 sub { my $lines_ref = orig_slurp_to_array( $file ) },
552 cmpthese( $result ) ;
555 ######################################
556 # uri's old fast slurp
560 my( $file_name ) = shift ;
563 open( FH, $file_name ) || carp "can't open $file_name $!" ;
565 return <FH> if wantarray ;
569 read( FH, $buf, -s FH ) ;
575 my( $file_name ) = shift ;
578 open( FH, $file_name ) || carp "can't open $file_name $!" ;
580 return <FH> if wantarray ;
584 sysread( FH, $buf, -s FH ) ;
588 ######################################
589 # from File::Slurp.pm on cpan
595 local($/) = wantarray ? $/ : undef;
600 open(F, "<$file") || croak "open $file: $!";
602 close(F) || croak "close $file: $!";
604 return $r[0] unless wantarray;
609 ######################################
610 # from Slurp.pm on cpan
613 local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
618 my @array = slurp( @_ );
619 return wantarray ? @array : \@array;
623 my $scalar = slurp( @_ );
627 ######################################
628 # very slow slurp code used by a client
632 my $fh = new FileHandle $file or
633 warn("Util::file_contents:Can't open file $file"), return '';
634 return join '', <$fh>;
637 # same code but doesn't use FileHandle.pm
639 sub file_contents_no_OO {
643 open( FH, $file ) || carp "can't open $file $!" ;
645 return join '', <FH>;
648 ##########################