extras/slurp_bench.pl

   1 #!/usr/local/bin/perl
   2
   3 use strict ;
   4 use warnings ;
   5
   6 use Getopt::Long ;
   7 use Benchmark qw( timethese cmpthese ) ;
   8 use Carp ;
   9 use FileHandle ;
  10 use Fcntl qw( :DEFAULT :seek );
  11
  12 use File::Slurp () ;
  13 use FileSlurp_12 () ;
  14
  15 my $file_name = 'slurp_data' ;
  16 my( @lines, $text ) ;
  17
  18 my %opts ;
  19
  20 parse_options() ;
  21
  22 run_benchmarks() ;
  23
  24 unlink $file_name ;
  25
  26 exit ;
  27
  28 sub run_benchmarks {
  29
  30         foreach my $size ( @{$opts{size_list}} ) {
  31
  32                 @lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
  33                 $text = join( '', @lines ) ;
  34
  35                 my $overage = length($text) - $size ;
  36                 substr( $text, -$overage, $overage, '' ) ;
  37                 substr( $lines[-1], -$overage, $overage, '' ) ;
  38
  39                 if ( $opts{slurp} ) {
  40
  41                         File::Slurp::write_file( $file_name, $text ) ;
  42
  43                         bench_list_slurp( $size ) if $opts{list} ;
  44                         bench_scalar_slurp( $size ) if $opts{scalar} ;
  45                 }
  46
  47                 if ( $opts{spew} ) {
  48
  49                         bench_spew_list( $size ) if $opts{list} ;
  50                         bench_scalar_spew( $size ) if $opts{scalar} ;
  51                 }
  52         }
  53 }
  54
  55 ##########################################
  56 ##########################################
  57 sub bench_scalar_slurp {
  58
  59         my ( $size ) = @_ ;
  60
  61         print "\n\nReading (Slurp) into a scalar: Size = $size bytes\n\n" ;
  62
  63         my $buffer ;
  64
  65         my $result = timethese( $opts{iterations}, {
  66
  67                 'FS::read_file' =>
  68                         sub { my $text = File::Slurp::read_file( $file_name ) },
  69
  70                 'FS12::read_file' =>
  71                         sub { my $text = FileSlurp_12::read_file( $file_name ) },
  72
  73 #               'FS::read_file_buf_ref' =>
  74 #                       sub { my $text ;
  75 #                          File::Slurp::read_file( $file_name, buf_ref => \$text ) },
  76 #               'FS::read_file_buf_ref2' =>
  77 #                       sub {
  78 #                          File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
  79 #               'FS::read_file_scalar_ref' =>
  80 #                       sub { my $text =
  81 #                           File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
  82
  83                 old_sysread_file =>
  84                         sub { my $text = old_sysread_file( $file_name ) },
  85
  86                 old_read_file =>
  87                         sub { my $text = old_read_file( $file_name ) },
  88
  89                 orig_read_file =>
  90                         sub { my $text = orig_read_file( $file_name ) },
  91
  92                 orig_slurp =>
  93                         sub { my $text = orig_slurp_scalar( $file_name ) },
  94
  95                 file_contents =>
  96                         sub { my $text = file_contents( $file_name ) },
  97
  98                 file_contents_no_OO =>
  99                         sub { my $text = file_contents_no_OO( $file_name ) },
 100         } ) ;
 101
 102         cmpthese( $result ) ;
 103 }
 104
 105 ##########################################
 106
 107 sub bench_list_slurp {
 108
 109         my ( $size ) = @_ ;
 110
 111         print "\n\nReading (Slurp) into a list: Size = $size bytes\n\n" ;
 112
 113         my $result = timethese( $opts{iterations},  {
 114
 115                 'FS::read_file' =>
 116                         sub { my @lines = File::Slurp::read_file( $file_name ) },
 117
 118                 'FS::read_file_array_ref' =>
 119                         sub { my $lines_ref =
 120                              File::Slurp::read_file( $file_name, array_ref => 1 ) },
 121
 122                 'FS::read_file_scalar' =>
 123                         sub { my $lines_ref =
 124                              [ File::Slurp::read_file( $file_name ) ] },
 125
 126                 old_sysread_file =>
 127                         sub { my @lines = old_sysread_file( $file_name ) },
 128
 129                 old_read_file =>
 130                         sub { my @lines = old_read_file( $file_name ) },
 131
 132                 orig_read_file =>
 133                         sub { my @lines = orig_read_file( $file_name ) },
 134
 135                 orig_slurp_array =>
 136                         sub { my @lines = orig_slurp_array( $file_name ) },
 137
 138                 orig_slurp_array_ref =>
 139                         sub { my $lines_ref = orig_slurp_array( $file_name ) },
 140         } ) ;
 141
 142         cmpthese( $result ) ;
 143 }
 144
 145 ######################################
 146 # uri's old fast slurp
 147
 148 sub old_read_file {
 149
 150         my( $file_name ) = shift ;
 151
 152         local( *FH ) ;
 153         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 154
 155         return <FH> if wantarray ;
 156
 157         my $buf ;
 158
 159         read( FH, $buf, -s FH ) ;
 160         return $buf ;
 161 }
 162
 163 sub old_sysread_file {
 164
 165         my( $file_name ) = shift ;
 166
 167         local( *FH ) ;
 168         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 169
 170         return <FH> if wantarray ;
 171
 172         my $buf ;
 173
 174         sysread( FH, $buf, -s FH ) ;
 175         return $buf ;
 176 }
 177
 178 ######################################
 179 # from File::Slurp.pm on cpan
 180
 181 sub orig_read_file
 182 {
 183         my ($file) = @_;
 184
 185         local($/) = wantarray ? $/ : undef;
 186         local(*F);
 187         my $r;
 188         my (@r);
 189
 190         open(F, "<$file") || croak "open $file: $!";
 191         @r = <F>;
 192         close(F) || croak "close $file: $!";
 193
 194         return $r[0] unless wantarray;
 195         return @r;
 196 }
 197
 198
 199 ######################################
 200 # from Slurp.pm on cpan
 201
 202 sub orig_slurp {
 203     local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
 204     return <ARGV>;
 205 }
 206
 207 sub orig_slurp_array {
 208     my @array = orig_slurp( @_ );
 209     return wantarray ? @array : \@array;
 210 }
 211
 212 sub orig_slurp_scalar {
 213     my $scalar = orig_slurp( @_ );
 214     return $scalar;
 215 }
 216
 217 ######################################
 218 # very slow slurp code used by a client
 219
 220 sub file_contents {
 221     my $file = shift;
 222     my $fh = new FileHandle $file or
 223         warn("Util::file_contents:Can't open file $file"), return '';
 224     return join '', <$fh>;
 225 }
 226
 227 # same code but doesn't use FileHandle.pm
 228
 229 sub file_contents_no_OO {
 230     my $file = shift;
 231
 232         local( *FH ) ;
 233         open( FH, $file ) || carp "can't open $file $!" ;
 234
 235     return join '', <FH>;
 236 }
 237
 238 ##########################################
 239 ##########################################
 240
 241 sub bench_spew_list {
 242
 243         my( $size ) = @_ ;
 244
 245         print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
 246
 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 ) },
 260         } ) ;
 261
 262         cmpthese( $result ) ;
 263 }
 264
 265 sub print_file {
 266
 267         my( $file_name ) = shift ;
 268
 269         local( *FH ) ;
 270         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 271
 272         print FH @_ ;
 273 }
 274
 275 sub print_join_file {
 276
 277         my( $file_name ) = shift ;
 278
 279         local( *FH ) ;
 280         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 281
 282         print FH join( '', @_ ) ;
 283 }
 284
 285 sub syswrite_join_file {
 286
 287         my( $file_name ) = shift ;
 288
 289         local( *FH ) ;
 290         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 291
 292         syswrite( FH, join( '', @_ ) ) ;
 293 }
 294
 295 sub sysopen_syswrite_join_file {
 296
 297         my( $file_name ) = shift ;
 298
 299         local( *FH ) ;
 300         sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
 301                                 carp "can't create $file_name $!" ;
 302
 303         syswrite( FH, join( '', @_ ) ) ;
 304 }
 305
 306 sub orig_write_file
 307 {
 308         my ($f, @data) = @_;
 309
 310         local(*F);
 311
 312         open(F, ">$f") || croak "open >$f: $!";
 313         (print F @data) || croak "write $f: $!";
 314         close(F) || croak "close $f: $!";
 315         return 1;
 316 }
 317
 318 ##########################################
 319
 320 sub bench_scalar_spew {
 321
 322         my ( $size ) = @_ ;
 323
 324         print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ;
 325
 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 ) },
 339         } ) ;
 340
 341         cmpthese( $result ) ;
 342 }
 343
 344 sub syswrite_file {
 345
 346         my( $file_name, $text ) = @_ ;
 347
 348         local( *FH ) ;
 349         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 350
 351         syswrite( FH, $text ) ;
 352 }
 353
 354 sub syswrite_file_ref {
 355
 356         my( $file_name, $text_ref ) = @_ ;
 357
 358         local( *FH ) ;
 359         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 360
 361         syswrite( FH, ${$text_ref} ) ;
 362 }
 363
 364 sub parse_options {
 365
 366         my $result = GetOptions (\%opts, qw(
 367                 iterations|i=s
 368                 direction|d=s
 369                 context|c=s
 370                 sizes|s=s
 371                 unlink|u
 372                 legend|key|l|k
 373                 help|usage
 374         ) ) ;
 375
 376         usage() unless $result ;
 377
 378         usage() if $opts{help} ;
 379
 380         legend() if $opts{legend} ;
 381
 382 # set defaults
 383
 384         $opts{direction} ||= 'both' ;
 385         $opts{context} ||= 'both' ;
 386         $opts{iterations} ||= -2 ;
 387         $opts{sizes} ||= '500,10k,1m' ;
 388
 389         if ( $opts{direction} eq 'both' ) {
 390
 391                 $opts{spew} = 1 ;
 392                 $opts{slurp} = 1 ;
 393         }
 394         elsif ( $opts{direction} eq 'in' ) {
 395
 396                 $opts{slurp} = 1 ;
 397
 398         }
 399         elsif ( $opts{direction} eq 'out' ) {
 400
 401                 $opts{spew} = 1 ;
 402         }
 403         else {
 404
 405                 usage( "Unknown direction: $opts{direction}" ) ;
 406         }
 407
 408         if ( $opts{context} eq 'both' ) {
 409
 410                 $opts{list} = 1 ;
 411                 $opts{scalar} = 1 ;
 412         }
 413         elsif ( $opts{context} eq 'scalar' ) {
 414
 415                 $opts{scalar} = 1 ;
 416
 417         }
 418         elsif ( $opts{context} eq 'list' ) {
 419
 420                 $opts{list} = 1 ;
 421         }
 422         else {
 423
 424                 usage( "Unknown context: $opts{context}" ) ;
 425         }
 426
 427         if ( $opts{context} eq 'both' ) {
 428
 429                 $opts{list} = 1 ;
 430                 $opts{scalar} = 1 ;
 431         }
 432         elsif ( $opts{context} eq 'scalar' ) {
 433
 434                 $opts{scalar} = 1 ;
 435
 436         }
 437         elsif ( $opts{context} eq 'list' ) {
 438
 439                 $opts{list} = 1 ;
 440         }
 441         else {
 442
 443                 usage( "Unknown context: $opts{context}" ) ;
 444         }
 445
 446         foreach my $size ( split ',', ( $opts{sizes} ) ) {
 447
 448
 449 # check for valid size and suffix. grab both.
 450
 451                 usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
 452
 453 # handle suffix multipliers
 454
 455                 $size =  $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
 456
 457                 push( @{$opts{size_list}}, $size ) ;
 458         }
 459
 460 #use Data::Dumper ;
 461 #print Dumper \%opts ;
 462 }
 463
 464 sub legend {
 465
 466         die <<'LEGEND' ;
 467 --------------------------------------------------------------------------
 468 Legend for the Slurp Benchmark Entries
 469
 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'.
 476
 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
 483                                 data
 484         syswrite/join           Open a file, call syswrite on joined list data
 485         sysopen/syswrite        Sysopen a file, call syswrite on joined list
 486                                 data
 487         original write_file     write_file code from original File::Slurp
 488                                 (pre-version 9999.*)
 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'.
 492
 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
 500                                 data
 501         orig_write_file         write_file code from original File::Slurp
 502                                 (pre-version 9999.*)
 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'.
 506
 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
 511                                         ref in any context
 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'.
 522
 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 -
 527                                         returns scalar
 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
 532                                         existing buffer
 533         FS::read_file_scalar_ref        Current F::S read_file - returns a
 534                                         scalar ref
 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 --------------------------------------------------------------------------
 542 LEGEND
 543 }
 544
 545 sub usage {
 546
 547         my( $err ) = @_ ;
 548
 549         $err ||= '' ;
 550
 551         die <<DIE ;
 552 $err
 553 Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
 554           [--sizes=<size_list>] [--legend] [--help]
 555
 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).
 560
 561         --direction=<dir>       Which direction to slurp: 'in', 'out' or 'both'.
 562         -d=<dir>                Default is 'both'.
 563
 564         --context=<con>         Which context is used for slurping: 'list',
 565         -c=<con>                'scalar' or 'both'. Default is 'both'.
 566
 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'.
 571
 572         --unlink                Unlink the written file before each time
 573         -u                      a file is written
 574
 575         --legend                Print out a legend of all the benchmark entries.
 576         --key
 577         -l
 578         -k
 579
 580         --help                  Print this help text
 581         --usage
 582 DIE
 583
 584 }
 585
 586 __END__
 587