Commit | Line | Data |
635c7876 |
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 () ; |
99709852 |
13 | use FileSlurp_12 () ; |
635c7876 |
14 | |
b03ff8fd |
15 | my $file_name = 'slurp_data' ; |
8ff593f5 |
16 | my( @lines, $text ) ; |
635c7876 |
17 | |
fa575d4f |
18 | my %opts ; |
635c7876 |
19 | |
20 | parse_options() ; |
21 | |
22 | run_benchmarks() ; |
23 | |
b03ff8fd |
24 | unlink $file_name ; |
635c7876 |
25 | |
26 | exit ; |
27 | |
635c7876 |
28 | sub run_benchmarks { |
29 | |
fa575d4f |
30 | foreach my $size ( @{$opts{size_list}} ) { |
635c7876 |
31 | |
fa575d4f |
32 | @lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ; |
635c7876 |
33 | $text = join( '', @lines ) ; |
fa575d4f |
34 | |
35 | my $overage = length($text) - $size ; |
36 | substr( $text, -$overage, $overage, '' ) ; |
37 | substr( $lines[-1], -$overage, $overage, '' ) ; |
635c7876 |
38 | |
8ff593f5 |
39 | if ( $opts{slurp} ) { |
40 | |
b03ff8fd |
41 | File::Slurp::write_file( $file_name, $text ) ; |
8ff593f5 |
42 | |
43 | bench_list_slurp( $size ) if $opts{list} ; |
44 | bench_scalar_slurp( $size ) if $opts{scalar} ; |
45 | } |
635c7876 |
46 | |
8ff593f5 |
47 | if ( $opts{spew} ) { |
48 | |
49 | bench_spew_list( $size ) if $opts{list} ; |
50 | bench_scalar_spew( $size ) if $opts{scalar} ; |
51 | } |
635c7876 |
52 | } |
53 | } |
54 | |
b03ff8fd |
55 | ########################################## |
99709852 |
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 | |
a878bbb4 |
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 ) }, |
99709852 |
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 | ########################################## |
b03ff8fd |
240 | |
635c7876 |
241 | sub bench_spew_list { |
242 | |
8ff593f5 |
243 | my( $size ) = @_ ; |
635c7876 |
244 | |
245 | print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ; |
246 | |
8ff593f5 |
247 | my $result = timethese( $opts{iterations}, { |
b03ff8fd |
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 ) }, |
635c7876 |
260 | } ) ; |
261 | |
262 | cmpthese( $result ) ; |
263 | } |
264 | |
8ff593f5 |
265 | sub print_file { |
266 | |
267 | my( $file_name ) = shift ; |
268 | |
8ff593f5 |
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 | |
8ff593f5 |
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 | |
8ff593f5 |
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 | |
8ff593f5 |
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 | |
8ff593f5 |
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 | |
b03ff8fd |
318 | ########################################## |
635c7876 |
319 | |
b03ff8fd |
320 | sub bench_scalar_spew { |
635c7876 |
321 | |
b03ff8fd |
322 | my ( $size ) = @_ ; |
635c7876 |
323 | |
b03ff8fd |
324 | print "\n\nWriting (Spew) a scalar: Size = $size bytes\n\n" ; |
635c7876 |
325 | |
b03ff8fd |
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 | } ) ; |
635c7876 |
340 | |
b03ff8fd |
341 | cmpthese( $result ) ; |
342 | } |
635c7876 |
343 | |
b03ff8fd |
344 | sub syswrite_file { |
635c7876 |
345 | |
b03ff8fd |
346 | my( $file_name, $text ) = @_ ; |
635c7876 |
347 | |
b03ff8fd |
348 | local( *FH ) ; |
349 | open( FH, ">$file_name" ) || carp "can't create $file_name $!" ; |
635c7876 |
350 | |
b03ff8fd |
351 | syswrite( FH, $text ) ; |
352 | } |
635c7876 |
353 | |
b03ff8fd |
354 | sub syswrite_file_ref { |
635c7876 |
355 | |
b03ff8fd |
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 | |
635c7876 |
364 | sub parse_options { |
365 | |
fa575d4f |
366 | my $result = GetOptions (\%opts, qw( |
367 | iterations|i=s |
368 | direction|d=s |
369 | context|c=s |
370 | sizes|s=s |
b03ff8fd |
371 | unlink|u |
fa575d4f |
372 | legend|key|l|k |
373 | help|usage |
374 | ) ) ; |
375 | |
376 | usage() unless $result ; |
377 | |
378 | usage() if $opts{help} ; |
635c7876 |
379 | |
fa575d4f |
380 | legend() if $opts{legend} ; |
635c7876 |
381 | |
fa575d4f |
382 | # set defaults |
635c7876 |
383 | |
fa575d4f |
384 | $opts{direction} ||= 'both' ; |
385 | $opts{context} ||= 'both' ; |
386 | $opts{iterations} ||= -2 ; |
a878bbb4 |
387 | $opts{sizes} ||= '512,10k,1m' ; |
fa575d4f |
388 | |
389 | if ( $opts{direction} eq 'both' ) { |
390 | |
635c7876 |
391 | $opts{spew} = 1 ; |
392 | $opts{slurp} = 1 ; |
393 | } |
fa575d4f |
394 | elsif ( $opts{direction} eq 'in' ) { |
635c7876 |
395 | |
fa575d4f |
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 | } |
635c7876 |
407 | |
fa575d4f |
408 | if ( $opts{context} eq 'both' ) { |
409 | |
635c7876 |
410 | $opts{list} = 1 ; |
411 | $opts{scalar} = 1 ; |
412 | } |
fa575d4f |
413 | elsif ( $opts{context} eq 'scalar' ) { |
635c7876 |
414 | |
fa575d4f |
415 | $opts{scalar} = 1 ; |
416 | |
417 | } |
418 | elsif ( $opts{context} eq 'list' ) { |
635c7876 |
419 | |
fa575d4f |
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' ) { |
635c7876 |
433 | |
fa575d4f |
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])?$/ ; |
635c7876 |
452 | |
fa575d4f |
453 | # handle suffix multipliers |
635c7876 |
454 | |
fa575d4f |
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' ; |
99709852 |
467 | -------------------------------------------------------------------------- |
8ff593f5 |
468 | Legend for the Slurp Benchmark Entries |
635c7876 |
469 | |
8ff593f5 |
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. |
99709852 |
473 | -------------------------------------------------------------------------- |
8ff593f5 |
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'. |
635c7876 |
476 | |
477 | Key Description/Source |
99709852 |
478 | ----- -------------------------- |
8ff593f5 |
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 |
99709852 |
482 | print/join Open a file and call print() on the joined list |
483 | data |
8ff593f5 |
484 | syswrite/join Open a file, call syswrite on joined list data |
99709852 |
485 | sysopen/syswrite Sysopen a file, call syswrite on joined list |
486 | data |
8ff593f5 |
487 | original write_file write_file code from original File::Slurp |
488 | (pre-version 9999.*) |
99709852 |
489 | -------------------------------------------------------------------------- |
b03ff8fd |
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 |
99709852 |
494 | ----- -------------------------- |
b03ff8fd |
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 |
99709852 |
499 | syswrite_file_ref Open a file, call syswrite on scalar ref of |
500 | data |
b03ff8fd |
501 | orig_write_file write_file code from original File::Slurp |
502 | (pre-version 9999.*) |
99709852 |
503 | -------------------------------------------------------------------------- |
b03ff8fd |
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 | |
99709852 |
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 | -------------------------------------------------------------------------- |
b03ff8fd |
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 | |
99709852 |
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 | -------------------------------------------------------------------------- |
fa575d4f |
542 | LEGEND |
635c7876 |
543 | } |
544 | |
fa575d4f |
545 | sub usage { |
635c7876 |
546 | |
fa575d4f |
547 | my( $err ) = @_ ; |
635c7876 |
548 | |
fa575d4f |
549 | $err ||= '' ; |
635c7876 |
550 | |
fa575d4f |
551 | die <<DIE ; |
552 | $err |
553 | Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>] |
554 | [--sizes=<size_list>] [--legend] [--help] |
635c7876 |
555 | |
fa575d4f |
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). |
635c7876 |
560 | |
fa575d4f |
561 | --direction=<dir> Which direction to slurp: 'in', 'out' or 'both'. |
562 | -d=<dir> Default is 'both'. |
635c7876 |
563 | |
fa575d4f |
564 | --context=<con> Which context is used for slurping: 'list', |
565 | -c=<con> 'scalar' or 'both'. Default is 'both'. |
635c7876 |
566 | |
fa575d4f |
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 |
a878bbb4 |
570 | for 1024 and 1024**2. Default is '512,10k,1m'. |
635c7876 |
571 | |
b03ff8fd |
572 | --unlink Unlink the written file before each time |
573 | -u a file is written |
574 | |
fa575d4f |
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 |
635c7876 |
582 | DIE |
583 | |
584 | } |
585 | |
635c7876 |
586 | __END__ |
587 | |