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 = 'slurp_data' ;
  15
  16 GetOptions (\my %opts,
  17         qw( slurp spew scalar list sizes=s key duration=i help ) ) ;
  18
  19 parse_options() ;
  20
  21 run_benchmarks() ;
  22
  23 unlink $file ;
  24
  25 exit ;
  26
  27 my( @lines, $text, $size ) ;
  28
  29 sub run_benchmarks {
  30
  31         foreach my $size ( @{$opts{sizes}} ) {
  32
  33                 @lines = ( 'a' x 80 . "\n") x $size ;
  34                 $text = join( '', @lines ) ;
  35                 $size = length $text ;
  36
  37                 File::Slurp::write_file( $file, $text ) ;
  38
  39 #               bench_list_slurp( $size ) if $opts{list} && $opts{slurp} ;
  40 #               bench_scalar_slurp( $size ) if $opts{scalar} && $opts{slurp} ;
  41                 bench_spew_list()
  42 #               bench_scalar_spew( $size ) if $opts{scalar} && $opts{spew} ;
  43         }
  44 }
  45
  46 sub bench_spew_list {
  47
  48         return unless $opts{list} && $opts{spew} ;
  49
  50         print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
  51
  52         my $result = timethese( $opts{duration}, {
  53
  54                 'FS::write_file' =>
  55                         sub { File::Slurp::write_file( $file, @lines ) },
  56
  57                 'print' =>
  58                         sub { print_file( $file, @lines ) },
  59
  60                 'print/join' =>
  61                         sub { print_join_file( $file, @lines ) },
  62
  63                 'syswrite/join' =>
  64                         sub { syswrite_join_file( $file, @lines ) },
  65
  66                 'original write_file' =>
  67                         sub { orig_write_file( $file, @lines ) },
  68
  69         } ) ;
  70
  71         cmpthese( $result ) ;
  72 }
  73
  74 # sub bench_scalar_spew {
  75
  76 #       my ( $size ) = @_ ;
  77
  78 #       print "\n\nScalar Spew of $size file\n\n" ;
  79
  80 #       my $result = timethese( $dur, {
  81
  82 #               new =>
  83 #                       sub { File::Slurp::write_file( $file, $text ) },
  84
  85 #               new_ref =>
  86 #                       sub { File::Slurp::write_file( $file, \$text ) },
  87
  88 #               print_file =>
  89 #                       sub { print_file( $file, $text ) },
  90
  91 #               print_join_file =>
  92 #                       sub { print_join_file( $file, $text ) },
  93
  94 #               syswrite_file =>
  95 #                       sub { syswrite_file( $file, $text ) },
  96
  97 #               syswrite_file2 =>
  98 #                       sub { syswrite_file2( $file, $text ) },
  99
 100 #               orig_write_file =>
 101 #                       sub { orig_write_file( $file, $text ) },
 102
 103 #       } ) ;
 104
 105 #       cmpthese( $result ) ;
 106 # }
 107
 108 # sub bench_scalar_slurp {
 109
 110 #       my ( $size ) = @_ ;
 111
 112 #       print "\n\nScalar Slurp of $size file\n\n" ;
 113
 114 #       my $buffer ;
 115
 116 #       my $result = timethese( $dur, {
 117
 118 #               new =>
 119 #                       sub { my $text = File::Slurp::read_file( $file ) },
 120
 121 #               new_buf_ref =>
 122 #                       sub { my $text ;
 123 #                          File::Slurp::read_file( $file, buf_ref => \$text ) },
 124 #               new_buf_ref2 =>
 125 #                       sub {
 126 #                          File::Slurp::read_file( $file, buf_ref => \$buffer ) },
 127 #               new_scalar_ref =>
 128 #                       sub { my $text =
 129 #                           File::Slurp::read_file( $file, scalar_ref => 1 ) },
 130
 131 #               read_file =>
 132 #                       sub { my $text = read_file( $file ) },
 133
 134 #               sysread_file =>
 135 #                       sub { my $text = sysread_file( $file ) },
 136
 137 #               orig_read_file =>
 138 #                       sub { my $text = orig_read_file( $file ) },
 139
 140 #               'Slurp.pm scalar' =>
 141 #                       sub { my $text = slurp_scalar( $file ) },
 142
 143 #               file_contents =>
 144 #                       sub { my $text = file_contents( $file ) },
 145
 146 #               file_contents_no_OO =>
 147 #                       sub { my $text = file_contents_no_OO( $file ) },
 148 #       } ) ;
 149
 150 #       cmpthese( $result ) ;
 151 # }
 152
 153 # sub bench_list_slurp {
 154
 155 #       my ( $size ) = @_ ;
 156
 157 #       print "\n\nList Slurp of $size file\n\n" ;
 158
 159 #       my $result = timethese( $dur, {
 160
 161 #               new =>
 162 #                       sub { my @lines = File::Slurp::read_file( $file ) },
 163
 164 #               new_array_ref =>
 165 #                       sub { my $lines_ref =
 166 #                            File::Slurp::read_file( $file, array_ref => 1 ) },
 167
 168 #               new_in_anon_array =>
 169 #                       sub { my $lines_ref =
 170 #                            [ File::Slurp::read_file( $file ) ] },
 171
 172 #               read_file =>
 173 #                       sub { my @lines = read_file( $file ) },
 174
 175 #               sysread_file =>
 176 #                       sub { my @lines = sysread_file( $file ) },
 177
 178 #               orig_read_file =>
 179 #                       sub { my @lines = orig_read_file( $file ) },
 180
 181 #               'Slurp.pm to array' =>
 182 #                       sub { my @lines = slurp_array( $file ) },
 183
 184 #               orig_slurp_to_array_ref =>
 185 #                       sub { my $lines_ref = orig_slurp_to_array( $file ) },
 186 #       } ) ;
 187
 188 #       cmpthese( $result ) ;
 189 # }
 190
 191
 192 ###########################
 193 # write file benchmark subs
 194 ###########################
 195
 196
 197 sub print_file {
 198
 199         my( $file_name ) = shift ;
 200
 201         local( *FH ) ;
 202
 203         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 204
 205         print FH @_ ;
 206 }
 207
 208 sub print_file2 {
 209
 210         my( $file_name ) = shift ;
 211
 212         local( *FH ) ;
 213
 214         my $mode = ( -e $file_name ) ? '<' : '>' ;
 215
 216         open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
 217
 218         print FH @_ ;
 219 }
 220
 221 sub print_join_file {
 222
 223         my( $file_name ) = shift ;
 224
 225         local( *FH ) ;
 226
 227         my $mode = ( -e $file_name ) ? '<' : '>' ;
 228
 229         open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
 230
 231         print FH join( '', @_ ) ;
 232 }
 233
 234
 235 sub syswrite_join_file {
 236
 237         my( $file_name ) = shift ;
 238
 239         local( *FH ) ;
 240
 241         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 242
 243         syswrite( FH, join( '', @_ ) ) ;
 244 }
 245
 246 sub sysopen_syswrite_join_file {
 247
 248         my( $file_name ) = shift ;
 249
 250         local( *FH ) ;
 251
 252         sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
 253                                 carp "can't create $file_name $!" ;
 254
 255         syswrite( FH, join( '', @_ ) ) ;
 256 }
 257
 258 sub orig_write_file
 259 {
 260         my ($f, @data) = @_;
 261
 262         local(*F);
 263
 264         open(F, ">$f") || croak "open >$f: $!";
 265         (print F @data) || croak "write $f: $!";
 266         close(F) || croak "close $f: $!";
 267         return 1;
 268 }
 269
 270
 271 #######################
 272 # top level subs for script
 273
 274 #######################
 275
 276 sub parse_options {
 277
 278         help() if $opts{help} ;
 279
 280         key() if $opts{key} ;
 281
 282         unless( $opts{spew} || $opts{slurp} ) {
 283
 284                 $opts{spew} = 1 ;
 285                 $opts{slurp} = 1 ;
 286         }
 287
 288         unless( $opts{list} || $opts{scalar} ) {
 289
 290                 $opts{list} = 1 ;
 291                 $opts{scalar} = 1 ;
 292         }
 293
 294         $opts{sizes} = [split ',', ( $opts{sizes} || '10,100,1000' ) ];
 295
 296         $opts{duration} ||= -2 ;
 297 }
 298
 299 sub key {
 300
 301         print <<'KEY' ;
 302
 303 Key to Slurp/Spew Benchmarks
 304
 305
 306 Write a list of lines to a file
 307
 308         Key                     Description/Source
 309         ---                     ------------------
 310
 311         FS:write_file           Current File::Slurp::write_file
 312         FS:write_file_ref       Current File::Slurp::write_file (scalar ref)
 313         print                   Open a file and call print()
 314         syswrite/join           Open a file, call syswrite on joined lines
 315         sysopen/syswrite        Sysopen a file, call syswrite on joined lines
 316         original write_file     Original (pre 9999.*) File::Slurp::write_file
 317
 318
 319 KEY
 320
 321         exit ;
 322 }
 323
 324 sub help {
 325
 326         die <<DIE ;
 327
 328 Usage: $0 [--list] [--scalar] [--slurp] [--spew]
 329           [--sizes=10,100] [--help]
 330
 331         --list          Run the list context benchmarks
 332         --scalar        Run the scalar context benchmarks
 333                         Those default to on unless one is set
 334
 335         --slurp         Run the slurp benchmarks
 336         --spew          Run the spew benchmarks
 337                         Those default to on unless one is set
 338
 339         --sizes         Comma separated list of file sizes to benchmark
 340                         Defaults to 10,100,1000
 341
 342         --key           Print the benchmark names and code orig_ins
 343
 344         --help          Print this help text
 345
 346 DIE
 347
 348 }
 349
 350
 351 __END__
 352
 353
 354 sub bench_scalar_spew {
 355
 356         my ( $size ) = @_ ;
 357
 358         print "\n\nScalar Spew of $size file\n\n" ;
 359
 360         my $result = timethese( $dur, {
 361
 362                 new =>
 363                         sub { File::Slurp::write_file( $file, $text ) },
 364
 365                 new_ref =>
 366                         sub { File::Slurp::write_file( $file, \$text ) },
 367
 368                 print_file =>
 369                         sub { print_file( $file, $text ) },
 370
 371                 print_join_file =>
 372                         sub { print_join_file( $file, $text ) },
 373
 374                 syswrite_file =>
 375                         sub { syswrite_file( $file, $text ) },
 376
 377                 syswrite_file2 =>
 378                         sub { syswrite_file2( $file, $text ) },
 379
 380                 orig_write_file =>
 381                         sub { orig_write_file( $file, $text ) },
 382
 383         } ) ;
 384
 385         cmpthese( $result ) ;
 386 }
 387
 388 sub bench_scalar_slurp {
 389
 390         my ( $size ) = @_ ;
 391
 392         print "\n\nScalar Slurp of $size file\n\n" ;
 393
 394         my $buffer ;
 395
 396         my $result = timethese( $dur, {
 397
 398                 new =>
 399                         sub { my $text = File::Slurp::read_file( $file ) },
 400
 401                 new_buf_ref =>
 402                         sub { my $text ;
 403                            File::Slurp::read_file( $file, buf_ref => \$text ) },
 404                 new_buf_ref2 =>
 405                         sub {
 406                            File::Slurp::read_file( $file, buf_ref => \$buffer ) },
 407                 new_scalar_ref =>
 408                         sub { my $text =
 409                             File::Slurp::read_file( $file, scalar_ref => 1 ) },
 410
 411                 read_file =>
 412                         sub { my $text = read_file( $file ) },
 413
 414                 sysread_file =>
 415                         sub { my $text = sysread_file( $file ) },
 416
 417                 orig_read_file =>
 418                         sub { my $text = orig_read_file( $file ) },
 419
 420                 orig_slurp =>
 421                         sub { my $text = orig_slurp_to_scalar( $file ) },
 422
 423                 file_contents =>
 424                         sub { my $text = file_contents( $file ) },
 425
 426                 file_contents_no_OO =>
 427                         sub { my $text = file_contents_no_OO( $file ) },
 428         } ) ;
 429
 430         cmpthese( $result ) ;
 431 }
 432
 433 sub bench_list_slurp {
 434
 435         my ( $size ) = @_ ;
 436
 437         print "\n\nList Slurp of $size file\n\n" ;
 438
 439         my $result = timethese( $dur, {
 440
 441                 new =>
 442                         sub { my @lines = File::Slurp::read_file( $file ) },
 443
 444                 new_array_ref =>
 445                         sub { my $lines_ref =
 446                              File::Slurp::read_file( $file, array_ref => 1 ) },
 447
 448                 new_in_anon_array =>
 449                         sub { my $lines_ref =
 450                              [ File::Slurp::read_file( $file ) ] },
 451
 452                 read_file =>
 453                         sub { my @lines = read_file( $file ) },
 454
 455                 sysread_file =>
 456                         sub { my @lines = sysread_file( $file ) },
 457
 458                 orig_read_file =>
 459                         sub { my @lines = orig_read_file( $file ) },
 460
 461                 orig_slurp_to_array =>
 462                         sub { my @lines = orig_slurp_to_array( $file ) },
 463
 464                 orig_slurp_to_array_ref =>
 465                         sub { my $lines_ref = orig_slurp_to_array( $file ) },
 466         } ) ;
 467
 468         cmpthese( $result ) ;
 469 }
 470
 471 ######################################
 472 # uri's old fast slurp
 473
 474 sub read_file {
 475
 476         my( $file_name ) = shift ;
 477
 478         local( *FH ) ;
 479         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 480
 481         return <FH> if wantarray ;
 482
 483         my $buf ;
 484
 485         read( FH, $buf, -s FH ) ;
 486         return $buf ;
 487 }
 488
 489 sub sysread_file {
 490
 491         my( $file_name ) = shift ;
 492
 493         local( *FH ) ;
 494         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 495
 496         return <FH> if wantarray ;
 497
 498         my $buf ;
 499
 500         sysread( FH, $buf, -s FH ) ;
 501         return $buf ;
 502 }
 503
 504 ######################################
 505 # from File::Slurp.pm on cpan
 506
 507 sub orig_read_file
 508 {
 509         my ($file) = @_;
 510
 511         local($/) = wantarray ? $/ : undef;
 512         local(*F);
 513         my $r;
 514         my (@r);
 515
 516         open(F, "<$file") || croak "open $file: $!";
 517         @r = <F>;
 518         close(F) || croak "close $file: $!";
 519
 520         return $r[0] unless wantarray;
 521         return @r;
 522 }
 523
 524
 525 ######################################
 526 # from Slurp.pm on cpan
 527
 528 sub slurp {
 529     local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
 530     return <ARGV>;
 531 }
 532
 533 sub slurp_array {
 534     my @array = slurp( @_ );
 535     return wantarray ? @array : \@array;
 536 }
 537
 538 sub slurp_scalar {
 539     my $scalar = slurp( @_ );
 540     return $scalar;
 541 }
 542
 543 ######################################
 544 # very slow slurp code used by a client
 545
 546 sub file_contents {
 547     my $file = shift;
 548     my $fh = new FileHandle $file or
 549         warn("Util::file_contents:Can't open file $file"), return '';
 550     return join '', <$fh>;
 551 }
 552
 553 # same code but doesn't use FileHandle.pm
 554
 555 sub file_contents_no_OO {
 556     my $file = shift;
 557
 558         local( *FH ) ;
 559         open( FH, $file ) || carp "can't open $file $!" ;
 560
 561     return join '', <FH>;
 562 }
 563
 564 ##########################