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
  14 my $file_name = 'slurp_data' ;
  15 my( @lines, $text ) ;
  16
  17 my %opts ;
  18
  19 parse_options() ;
  20
  21 run_benchmarks() ;
  22
  23 unlink $file_name ;
  24
  25 exit ;
  26
  27 sub run_benchmarks {
  28
  29         foreach my $size ( @{$opts{size_list}} ) {
  30
  31                 @lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
  32                 $text = join( '', @lines ) ;
  33
  34                 my $overage = length($text) - $size ;
  35                 substr( $text, -$overage, $overage, '' ) ;
  36                 substr( $lines[-1], -$overage, $overage, '' ) ;
  37
  38                 if ( $opts{slurp} ) {
  39
  40                         File::Slurp::write_file( $file_name, $text ) ;
  41
  42                         bench_list_slurp( $size ) if $opts{list} ;
  43                         bench_scalar_slurp( $size ) if $opts{scalar} ;
  44                 }
  45
  46                 if ( $opts{spew} ) {
  47
  48                         bench_spew_list( $size ) if $opts{list} ;
  49                         bench_scalar_spew( $size ) if $opts{scalar} ;
  50                 }
  51         }
  52 }
  53
  54 ##########################################
  55
  56 sub bench_spew_list {
  57
  58         my( $size ) = @_ ;
  59
  60         print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
  61
  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 ) },
  75         } ) ;
  76
  77         cmpthese( $result ) ;
  78 }
  79
  80 sub print_file {
  81
  82         my( $file_name ) = shift ;
  83
  84         local( *FH ) ;
  85         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
  86
  87         print FH @_ ;
  88 }
  89
  90 sub print_join_file {
  91
  92         my( $file_name ) = shift ;
  93
  94         local( *FH ) ;
  95         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
  96
  97         print FH join( '', @_ ) ;
  98 }
  99
 100 sub syswrite_join_file {
 101
 102         my( $file_name ) = shift ;
 103
 104         local( *FH ) ;
 105         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 106
 107         syswrite( FH, join( '', @_ ) ) ;
 108 }
 109
 110 sub sysopen_syswrite_join_file {
 111
 112         my( $file_name ) = shift ;
 113
 114         local( *FH ) ;
 115         sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
 116                                 carp "can't create $file_name $!" ;
 117
 118         syswrite( FH, join( '', @_ ) ) ;
 119 }
 120
 121 sub orig_write_file
 122 {
 123         my ($f, @data) = @_;
 124
 125         local(*F);
 126
 127         open(F, ">$f") || croak "open >$f: $!";
 128         (print F @data) || croak "write $f: $!";
 129         close(F) || croak "close $f: $!";
 130         return 1;
 131 }
 132
 133 ##########################################
 134
 135 sub bench_scalar_spew {
 136
 137         my ( $size ) = @_ ;
 138
 139         print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ;
 140
 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 ) },
 154         } ) ;
 155
 156         cmpthese( $result ) ;
 157 }
 158
 159 sub syswrite_file {
 160
 161         my( $file_name, $text ) = @_ ;
 162
 163         local( *FH ) ;
 164         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 165
 166         syswrite( FH, $text ) ;
 167 }
 168
 169 sub syswrite_file_ref {
 170
 171         my( $file_name, $text_ref ) = @_ ;
 172
 173         local( *FH ) ;
 174         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 175
 176         syswrite( FH, ${$text_ref} ) ;
 177 }
 178
 179 #############################################
 180
 181
 182 # sub bench_scalar_slurp {
 183
 184 #       my ( $size ) = @_ ;
 185
 186 #       print "\n\nScalar Slurp of $size bytes\n\n" ;
 187
 188 #       my $buffer ;
 189
 190 #       my $result = timethese( $dur, {
 191
 192 #               new =>
 193 #                       sub { my $text = File::Slurp::read_file( $file_name ) },
 194
 195 #               new_buf_ref =>
 196 #                       sub { my $text ;
 197 #                          File::Slurp::read_file( $file_name, buf_ref => \$text ) },
 198 #               new_buf_ref2 =>
 199 #                       sub {
 200 #                          File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
 201 #               new_scalar_ref =>
 202 #                       sub { my $text =
 203 #                           File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
 204
 205 #               read_file =>
 206 #                       sub { my $text = read_file( $file_name ) },
 207
 208 #               sysread_file =>
 209 #                       sub { my $text = sysread_file( $file_name ) },
 210
 211 #               orig_read_file =>
 212 #                       sub { my $text = orig_read_file( $file_name ) },
 213
 214 #               'Slurp.pm scalar' =>
 215 #                       sub { my $text = slurp_scalar( $file_name ) },
 216
 217 #               file_contents =>
 218 #                       sub { my $text = file_contents( $file_name ) },
 219
 220 #               file_contents_no_OO =>
 221 #                       sub { my $text = file_contents_no_OO( $file_name ) },
 222 #       } ) ;
 223
 224 #       cmpthese( $result ) ;
 225 # }
 226
 227 # sub bench_list_slurp {
 228
 229 #       my ( $size ) = @_ ;
 230
 231 #       print "\n\nList Slurp of $size file\n\n" ;
 232
 233 #       my $result = timethese( $dur, {
 234
 235 #               new =>
 236 #                       sub { my @lines = File::Slurp::read_file( $file_name ) },
 237
 238 #               new_array_ref =>
 239 #                       sub { my $lines_ref =
 240 #                            File::Slurp::read_file( $file_name, array_ref => 1 ) },
 241
 242 #               new_in_anon_array =>
 243 #                       sub { my $lines_ref =
 244 #                            [ File::Slurp::read_file( $file_name ) ] },
 245
 246 #               read_file =>
 247 #                       sub { my @lines = read_file( $file_name ) },
 248
 249 #               sysread_file =>
 250 #                       sub { my @lines = sysread_file( $file_name ) },
 251
 252 #               orig_read_file =>
 253 #                       sub { my @lines = orig_read_file( $file_name ) },
 254
 255 #               'Slurp.pm to array' =>
 256 #                       sub { my @lines = slurp_array( $file_name ) },
 257
 258 #               orig_slurp_to_array_ref =>
 259 #                       sub { my $lines_ref = orig_slurp_to_array( $file_name ) },
 260 #       } ) ;
 261
 262 #       cmpthese( $result ) ;
 263 # }
 264
 265
 266 ###########################
 267 # write file benchmark subs
 268 ###########################
 269
 270
 271
 272 #######################
 273 # top level subs for script
 274
 275 #######################
 276
 277 sub parse_options {
 278
 279         my $result = GetOptions (\%opts, qw(
 280                 iterations|i=s
 281                 direction|d=s
 282                 context|c=s
 283                 sizes|s=s
 284                 unlink|u
 285                 legend|key|l|k
 286                 help|usage
 287         ) ) ;
 288
 289         usage() unless $result ;
 290
 291         usage() if $opts{help} ;
 292
 293         legend() if $opts{legend} ;
 294
 295 # set defaults
 296
 297         $opts{direction} ||= 'both' ;
 298         $opts{context} ||= 'both' ;
 299         $opts{iterations} ||= -2 ;
 300         $opts{sizes} ||= '500,10k,1m' ;
 301
 302         if ( $opts{direction} eq 'both' ) {
 303
 304                 $opts{spew} = 1 ;
 305                 $opts{slurp} = 1 ;
 306         }
 307         elsif ( $opts{direction} eq 'in' ) {
 308
 309                 $opts{slurp} = 1 ;
 310
 311         }
 312         elsif ( $opts{direction} eq 'out' ) {
 313
 314                 $opts{spew} = 1 ;
 315         }
 316         else {
 317
 318                 usage( "Unknown direction: $opts{direction}" ) ;
 319         }
 320
 321         if ( $opts{context} eq 'both' ) {
 322
 323                 $opts{list} = 1 ;
 324                 $opts{scalar} = 1 ;
 325         }
 326         elsif ( $opts{context} eq 'scalar' ) {
 327
 328                 $opts{scalar} = 1 ;
 329
 330         }
 331         elsif ( $opts{context} eq 'list' ) {
 332
 333                 $opts{list} = 1 ;
 334         }
 335         else {
 336
 337                 usage( "Unknown context: $opts{context}" ) ;
 338         }
 339
 340         if ( $opts{context} eq 'both' ) {
 341
 342                 $opts{list} = 1 ;
 343                 $opts{scalar} = 1 ;
 344         }
 345         elsif ( $opts{context} eq 'scalar' ) {
 346
 347                 $opts{scalar} = 1 ;
 348
 349         }
 350         elsif ( $opts{context} eq 'list' ) {
 351
 352                 $opts{list} = 1 ;
 353         }
 354         else {
 355
 356                 usage( "Unknown context: $opts{context}" ) ;
 357         }
 358
 359         foreach my $size ( split ',', ( $opts{sizes} ) ) {
 360
 361
 362 # check for valid size and suffix. grab both.
 363
 364                 usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
 365
 366 # handle suffix multipliers
 367
 368                 $size =  $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
 369
 370                 push( @{$opts{size_list}}, $size ) ;
 371         }
 372
 373 #use Data::Dumper ;
 374 #print Dumper \%opts ;
 375 }
 376
 377 sub legend {
 378
 379         die <<'LEGEND' ;
 380 Legend for the Slurp Benchmark Entries
 381
 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.
 385
 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'.
 388
 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
 395                                 list data
 396         syswrite/join           Open a file, call syswrite on joined list data
 397         sysopen/syswrite        Sysopen a file, call syswrite on joined
 398                                 list data
 399         original write_file     write_file code from original File::Slurp
 400                                 (pre-version 9999.*)
 401
 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'.
 404
 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
 413                                 (pre-version 9999.*)
 414
 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'.
 417
 418 FIX THIS
 419
 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
 426                                 list data
 427         syswrite/join           Open a file, call syswrite on joined list data
 428         sysopen/syswrite        Sysopen a file, call syswrite on joined
 429                                 list data
 430         original write_file     write_file code from original File::Slurp
 431                                 (pre-version 9999.*)
 432
 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'.
 435
 436 FIX THIS
 437
 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
 444                                 list data
 445         syswrite/join           Open a file, call syswrite on joined list data
 446         sysopen/syswrite        Sysopen a file, call syswrite on joined
 447                                 list data
 448         original write_file     write_file code from original File::Slurp
 449                                 (pre-version 9999.*)
 450
 451 LEGEND
 452 }
 453
 454 sub usage {
 455
 456         my( $err ) = @_ ;
 457
 458         $err ||= '' ;
 459
 460         die <<DIE ;
 461 $err
 462 Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
 463           [--sizes=<size_list>] [--legend] [--help]
 464
 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).
 469
 470         --direction=<dir>       Which direction to slurp: 'in', 'out' or 'both'.
 471         -d=<dir>                Default is 'both'.
 472
 473         --context=<con>         Which context is used for slurping: 'list',
 474         -c=<con>                'scalar' or 'both'. Default is 'both'.
 475
 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'.
 480
 481         --unlink                Unlink the written file before each time
 482         -u                      a file is written
 483
 484         --legend                Print out a legend of all the benchmark entries.
 485         --key
 486         -l
 487         -k
 488
 489         --help                  Print this help text
 490         --usage
 491 DIE
 492
 493 }
 494
 495 __END__
 496
 497
 498
 499 sub bench_scalar_slurp {
 500
 501         my ( $size ) = @_ ;
 502
 503         print "\n\nScalar Slurp of $size file\n\n" ;
 504
 505         my $buffer ;
 506
 507         my $result = timethese( $dur, {
 508
 509                 new =>
 510                         sub { my $text = File::Slurp::read_file( $file_name ) },
 511
 512                 new_buf_ref =>
 513                         sub { my $text ;
 514                            File::Slurp::read_file( $file_name, buf_ref => \$text ) },
 515                 new_buf_ref2 =>
 516                         sub {
 517                            File::Slurp::read_file( $file_name, buf_ref => \$buffer ) },
 518                 new_scalar_ref =>
 519                         sub { my $text =
 520                             File::Slurp::read_file( $file_name, scalar_ref => 1 ) },
 521
 522                 read_file =>
 523                         sub { my $text = read_file( $file_name ) },
 524
 525                 sysread_file =>
 526                         sub { my $text = sysread_file( $file_name ) },
 527
 528                 orig_read_file =>
 529                         sub { my $text = orig_read_file( $file_name ) },
 530
 531                 orig_slurp =>
 532                         sub { my $text = orig_slurp_to_scalar( $file_name ) },
 533
 534                 file_contents =>
 535                         sub { my $text = file_contents( $file_name ) },
 536
 537                 file_contents_no_OO =>
 538                         sub { my $text = file_contents_no_OO( $file_name ) },
 539         } ) ;
 540
 541         cmpthese( $result ) ;
 542 }
 543
 544 sub bench_list_slurp {
 545
 546         my ( $size ) = @_ ;
 547
 548         print "\n\nList Slurp of $size file\n\n" ;
 549
 550         my $result = timethese( $dur, {
 551
 552                 new =>
 553                         sub { my @lines = File::Slurp::read_file( $file_name ) },
 554
 555                 new_array_ref =>
 556                         sub { my $lines_ref =
 557                              File::Slurp::read_file( $file_name, array_ref => 1 ) },
 558
 559                 new_in_anon_array =>
 560                         sub { my $lines_ref =
 561                              [ File::Slurp::read_file( $file_name ) ] },
 562
 563                 read_file =>
 564                         sub { my @lines = read_file( $file_name ) },
 565
 566                 sysread_file =>
 567                         sub { my @lines = sysread_file( $file_name ) },
 568
 569                 orig_read_file =>
 570                         sub { my @lines = orig_read_file( $file_name ) },
 571
 572                 orig_slurp_to_array =>
 573                         sub { my @lines = orig_slurp_to_array( $file_name ) },
 574
 575                 orig_slurp_to_array_ref =>
 576                         sub { my $lines_ref = orig_slurp_to_array( $file_name ) },
 577         } ) ;
 578
 579         cmpthese( $result ) ;
 580 }
 581
 582 ######################################
 583 # uri's old fast slurp
 584
 585 sub read_file {
 586
 587         my( $file_name ) = shift ;
 588
 589         local( *FH ) ;
 590         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 591
 592         return <FH> if wantarray ;
 593
 594         my $buf ;
 595
 596         read( FH, $buf, -s FH ) ;
 597         return $buf ;
 598 }
 599
 600 sub sysread_file {
 601
 602         my( $file_name ) = shift ;
 603
 604         local( *FH ) ;
 605         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 606
 607         return <FH> if wantarray ;
 608
 609         my $buf ;
 610
 611         sysread( FH, $buf, -s FH ) ;
 612         return $buf ;
 613 }
 614
 615 ######################################
 616 # from File::Slurp.pm on cpan
 617
 618 sub orig_read_file
 619 {
 620         my ($file) = @_;
 621
 622         local($/) = wantarray ? $/ : undef;
 623         local(*F);
 624         my $r;
 625         my (@r);
 626
 627         open(F, "<$file") || croak "open $file: $!";
 628         @r = <F>;
 629         close(F) || croak "close $file: $!";
 630
 631         return $r[0] unless wantarray;
 632         return @r;
 633 }
 634
 635
 636 ######################################
 637 # from Slurp.pm on cpan
 638
 639 sub slurp {
 640     local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
 641     return <ARGV>;
 642 }
 643
 644 sub slurp_array {
 645     my @array = slurp( @_ );
 646     return wantarray ? @array : \@array;
 647 }
 648
 649 sub slurp_scalar {
 650     my $scalar = slurp( @_ );
 651     return $scalar;
 652 }
 653
 654 ######################################
 655 # very slow slurp code used by a client
 656
 657 sub file_contents {
 658     my $file = shift;
 659     my $fh = new FileHandle $file or
 660         warn("Util::file_contents:Can't open file $file"), return '';
 661     return join '', <$fh>;
 662 }
 663
 664 # same code but doesn't use FileHandle.pm
 665
 666 sub file_contents_no_OO {
 667     my $file = shift;
 668
 669         local( *FH ) ;
 670         open( FH, $file ) || carp "can't open $file $!" ;
 671
 672     return join '', <FH>;
 673 }
 674
 675 ##########################