slurp_talk/slurp_bench.pl

   1 #!/usr/local/bin/perl
   2
   3 use strict ;
   4
   5 use Benchmark qw( timethese cmpthese ) ;
   6 use Carp ;
   7 use FileHandle ;
   8 use Fcntl qw( :DEFAULT :seek );
   9
  10 use File::Slurp () ;
  11
  12 my $dur = shift || -2 ;
  13
  14 my $file = 'slurp_data' ;
  15
  16 my @lines = ( 'abc' x 30 . "\n")  x 100 ;
  17 my $text = join( '', @lines ) ;
  18
  19 bench_list_spew( 'SHORT' ) ;
  20 bench_scalar_spew( 'SHORT' ) ;
  21
  22 File::Slurp::write_file( $file, $text ) ;
  23
  24 bench_scalar_slurp( 'SHORT' ) ;
  25 bench_list_slurp( 'SHORT' ) ;
  26
  27 @lines = ( 'abc' x 40 . "\n")  x 1000 ;
  28 $text = join( '', @lines ) ;
  29
  30 bench_list_spew( 'LONG' ) ;
  31 bench_scalar_spew( 'LONG' ) ;
  32
  33 File::Slurp::write_file( $file, $text ) ;
  34
  35 bench_scalar_slurp( 'LONG' ) ;
  36 bench_list_slurp( 'LONG' ) ;
  37
  38 exit ;
  39
  40 sub bench_list_spew {
  41
  42         my ( $size ) = @_ ;
  43
  44         print "\n\nList Spew of $size file\n\n" ;
  45
  46         my $result = timethese( $dur, {
  47
  48                 new =>
  49                         sub { File::Slurp::write_file( $file, @lines ) },
  50
  51                 print_file =>
  52                         sub { print_file( $file, @lines ) },
  53
  54                 print_join_file =>
  55                         sub { print_join_file( $file, @lines ) },
  56
  57                 syswrite_file =>
  58                         sub { syswrite_file( $file, @lines ) },
  59
  60                 cpan_write_file =>
  61                         sub { cpan_write_file( $file, @lines ) },
  62
  63         } ) ;
  64
  65         cmpthese( $result ) ;
  66 }
  67
  68 sub bench_scalar_spew {
  69
  70         my ( $size ) = @_ ;
  71
  72         print "\n\nScalar Spew of $size file\n\n" ;
  73
  74         my $result = timethese( $dur, {
  75
  76                 new =>
  77                         sub { File::Slurp::write_file( $file, $text ) },
  78
  79                 new_ref =>
  80                         sub { File::Slurp::write_file( $file, \$text ) },
  81
  82                 print_file =>
  83                         sub { print_file( $file, $text ) },
  84
  85                 print_join_file =>
  86                         sub { print_join_file( $file, $text ) },
  87
  88                 syswrite_file =>
  89                         sub { syswrite_file( $file, $text ) },
  90
  91                 syswrite_file2 =>
  92                         sub { syswrite_file2( $file, $text ) },
  93
  94                 cpan_write_file =>
  95                         sub { cpan_write_file( $file, $text ) },
  96
  97         } ) ;
  98
  99         cmpthese( $result ) ;
 100 }
 101
 102 sub bench_scalar_slurp {
 103
 104         my ( $size ) = @_ ;
 105
 106         print "\n\nScalar Slurp of $size file\n\n" ;
 107
 108         my $buffer ;
 109
 110         my $result = timethese( $dur, {
 111
 112                 new =>
 113                         sub { my $text = File::Slurp::read_file( $file ) },
 114
 115                 new_buf_ref =>
 116                         sub { my $text ;
 117                            File::Slurp::read_file( $file, buf_ref => \$text ) },
 118                 new_buf_ref2 =>
 119                         sub {
 120                            File::Slurp::read_file( $file, buf_ref => \$buffer ) },
 121                 new_scalar_ref =>
 122                         sub { my $text =
 123                             File::Slurp::read_file( $file, scalar_ref => 1 ) },
 124
 125                 read_file =>
 126                         sub { my $text = read_file( $file ) },
 127
 128                 sysread_file =>
 129                         sub { my $text = sysread_file( $file ) },
 130
 131                 cpan_read_file =>
 132                         sub { my $text = cpan_read_file( $file ) },
 133
 134                 cpan_slurp =>
 135                         sub { my $text = cpan_slurp_to_scalar( $file ) },
 136
 137                 file_contents =>
 138                         sub { my $text = file_contents( $file ) },
 139
 140                 file_contents_no_OO =>
 141                         sub { my $text = file_contents_no_OO( $file ) },
 142         } ) ;
 143
 144         cmpthese( $result ) ;
 145 }
 146
 147 sub bench_list_slurp {
 148
 149         my ( $size ) = @_ ;
 150
 151         print "\n\nList Slurp of $size file\n\n" ;
 152
 153         my $result = timethese( $dur, {
 154
 155                 new =>
 156                         sub { my @lines = File::Slurp::read_file( $file ) },
 157
 158                 new_array_ref =>
 159                         sub { my $lines_ref =
 160                              File::Slurp::read_file( $file, array_ref => 1 ) },
 161
 162                 new_in_anon_array =>
 163                         sub { my $lines_ref =
 164                              [ File::Slurp::read_file( $file ) ] },
 165
 166                 read_file =>
 167                         sub { my @lines = read_file( $file ) },
 168
 169                 sysread_file =>
 170                         sub { my @lines = sysread_file( $file ) },
 171
 172                 cpan_read_file =>
 173                         sub { my @lines = cpan_read_file( $file ) },
 174
 175                 cpan_slurp_to_array =>
 176                         sub { my @lines = cpan_slurp_to_array( $file ) },
 177
 178                 cpan_slurp_to_array_ref =>
 179                         sub { my $lines_ref = cpan_slurp_to_array( $file ) },
 180         } ) ;
 181
 182         cmpthese( $result ) ;
 183 }
 184
 185 ######################################
 186 # uri's old fast slurp
 187
 188 sub read_file {
 189
 190         my( $file_name ) = shift ;
 191
 192         local( *FH ) ;
 193         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 194
 195         return <FH> if wantarray ;
 196
 197         my $buf ;
 198
 199         read( FH, $buf, -s FH ) ;
 200         return $buf ;
 201 }
 202
 203 sub sysread_file {
 204
 205         my( $file_name ) = shift ;
 206
 207         local( *FH ) ;
 208         open( FH, $file_name ) || carp "can't open $file_name $!" ;
 209
 210         return <FH> if wantarray ;
 211
 212         my $buf ;
 213
 214         sysread( FH, $buf, -s FH ) ;
 215         return $buf ;
 216 }
 217
 218 ######################################
 219 # from File::Slurp.pm on cpan
 220
 221 sub cpan_read_file
 222 {
 223         my ($file) = @_;
 224
 225         local($/) = wantarray ? $/ : undef;
 226         local(*F);
 227         my $r;
 228         my (@r);
 229
 230         open(F, "<$file") || croak "open $file: $!";
 231         @r = <F>;
 232         close(F) || croak "close $file: $!";
 233
 234         return $r[0] unless wantarray;
 235         return @r;
 236 }
 237
 238 sub cpan_write_file
 239 {
 240         my ($f, @data) = @_;
 241
 242         local(*F);
 243
 244         open(F, ">$f") || croak "open >$f: $!";
 245         (print F @data) || croak "write $f: $!";
 246         close(F) || croak "close $f: $!";
 247         return 1;
 248 }
 249
 250
 251 ######################################
 252 # from Slurp.pm on cpan
 253
 254 sub slurp {
 255     local( $/, @ARGV ) = ( wantarray ? $/ : undef, @_ );
 256     return <ARGV>;
 257 }
 258
 259 sub cpan_slurp_to_array {
 260     my @array = slurp( @_ );
 261     return wantarray ? @array : \@array;
 262 }
 263
 264 sub cpan_slurp_to_scalar {
 265     my $scalar = slurp( @_ );
 266     return $scalar;
 267 }
 268
 269 ######################################
 270 # very slow slurp code used by a client
 271
 272 sub file_contents {
 273     my $file = shift;
 274     my $fh = new FileHandle $file or
 275         warn("Util::file_contents:Can't open file $file"), return '';
 276     return join '', <$fh>;
 277 }
 278
 279 # same code but doesn't use FileHandle.pm
 280
 281 sub file_contents_no_OO {
 282     my $file = shift;
 283
 284         local( *FH ) ;
 285         open( FH, $file ) || carp "can't open $file $!" ;
 286
 287     return join '', <FH>;
 288 }
 289
 290 ##########################
 291
 292 sub print_file {
 293
 294         my( $file_name ) = shift ;
 295
 296         local( *FH ) ;
 297
 298         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 299
 300         print FH @_ ;
 301 }
 302
 303 sub print_file2 {
 304
 305         my( $file_name ) = shift ;
 306
 307         local( *FH ) ;
 308
 309         my $mode = ( -e $file_name ) ? '<' : '>' ;
 310
 311         open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
 312
 313         print FH @_ ;
 314 }
 315
 316 sub print_join_file {
 317
 318         my( $file_name ) = shift ;
 319
 320         local( *FH ) ;
 321
 322         my $mode = ( -e $file_name ) ? '<' : '>' ;
 323
 324         open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
 325
 326         print FH join( '', @_ ) ;
 327 }
 328
 329
 330 sub syswrite_file {
 331
 332         my( $file_name ) = shift ;
 333
 334         local( *FH ) ;
 335
 336         open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
 337
 338         syswrite( FH, join( '', @_ ) ) ;
 339 }
 340
 341 sub syswrite_file2 {
 342
 343         my( $file_name ) = shift ;
 344
 345         local( *FH ) ;
 346
 347         sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
 348                                 carp "can't create $file_name $!" ;
 349
 350         syswrite( FH, join( '', @_ ) ) ;
 351 }