use File::Slurp () ;
my $file = 'slurp_data' ;
+my( @lines, $text ) ;
-GetOptions (\my %opts,
- qw( slurp spew scalar list sizes=s key duration=i help ) ) ;
+my %opts ;
parse_options() ;
exit ;
-my( @lines, $text, $size ) ;
-
sub run_benchmarks {
- foreach my $size ( @{$opts{sizes}} ) {
+ foreach my $size ( @{$opts{size_list}} ) {
- @lines = ( 'a' x 80 . "\n") x $size ;
+ @lines = ( 'a' x 80 . "\n") x ( $size / 81 + 1 ) ;
$text = join( '', @lines ) ;
- $size = length $text ;
- File::Slurp::write_file( $file, $text ) ;
+ my $overage = length($text) - $size ;
+ substr( $text, -$overage, $overage, '' ) ;
+ substr( $lines[-1], -$overage, $overage, '' ) ;
+
+ if ( $opts{slurp} ) {
+
+ File::Slurp::write_file( $file, $text ) ;
-# bench_list_slurp( $size ) if $opts{list} && $opts{slurp} ;
-# bench_scalar_slurp( $size ) if $opts{scalar} && $opts{slurp} ;
- bench_spew_list()
-# bench_scalar_spew( $size ) if $opts{scalar} && $opts{spew} ;
+ bench_list_slurp( $size ) if $opts{list} ;
+ bench_scalar_slurp( $size ) if $opts{scalar} ;
+ }
+
+ if ( $opts{spew} ) {
+
+ bench_spew_list( $size ) if $opts{list} ;
+ bench_scalar_spew( $size ) if $opts{scalar} ;
+ }
}
}
sub bench_spew_list {
- return unless $opts{list} && $opts{spew} ;
+ my( $size ) = @_ ;
print "\n\nWriting (Spew) a list of lines: Size = $size bytes\n\n" ;
- my $result = timethese( $opts{duration}, {
-
+ my $result = timethese( $opts{iterations}, {
'FS::write_file' =>
sub { File::Slurp::write_file( $file, @lines ) },
-
+ 'FS::write_file Aref' =>
+ sub { File::Slurp::write_file( $file, \@lines ) },
'print' =>
sub { print_file( $file, @lines ) },
-
'print/join' =>
sub { print_join_file( $file, @lines ) },
-
'syswrite/join' =>
sub { syswrite_join_file( $file, @lines ) },
-
'original write_file' =>
sub { orig_write_file( $file, @lines ) },
-
} ) ;
cmpthese( $result ) ;
}
+sub print_file {
+
+ my( $file_name ) = shift ;
+
+ unlink $file_name ;
+
+ local( *FH ) ;
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ print FH @_ ;
+}
+
+sub print_join_file {
+
+ my( $file_name ) = shift ;
+
+ unlink $file_name ;
+
+ local( *FH ) ;
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ print FH join( '', @_ ) ;
+}
+
+sub syswrite_join_file {
+
+ my( $file_name ) = shift ;
+
+ unlink $file_name ;
+
+ local( *FH ) ;
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ syswrite( FH, join( '', @_ ) ) ;
+}
+
+sub sysopen_syswrite_join_file {
+
+ my( $file_name ) = shift ;
+
+ unlink $file_name ;
+
+ local( *FH ) ;
+ sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
+ carp "can't create $file_name $!" ;
+
+ syswrite( FH, join( '', @_ ) ) ;
+}
+
+sub orig_write_file
+{
+ my ($f, @data) = @_;
+
+ unlink $f ;
+
+ local(*F);
+
+ open(F, ">$f") || croak "open >$f: $!";
+ (print F @data) || croak "write $f: $!";
+ close(F) || croak "close $f: $!";
+ return 1;
+}
+
# sub bench_scalar_spew {
# my ( $size ) = @_ ;
###########################
-sub print_file {
-
- my( $file_name ) = shift ;
-
- local( *FH ) ;
-
- open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
-
- print FH @_ ;
-}
-
-sub print_file2 {
-
- my( $file_name ) = shift ;
- local( *FH ) ;
-
- my $mode = ( -e $file_name ) ? '<' : '>' ;
-
- open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
-
- print FH @_ ;
-}
-
-sub print_join_file {
-
- my( $file_name ) = shift ;
+#######################
+# top level subs for script
- local( *FH ) ;
+#######################
- my $mode = ( -e $file_name ) ? '<' : '>' ;
+sub parse_options {
- open( FH, "+$mode$file_name" ) || carp "can't create $file_name $!" ;
+ my $result = GetOptions (\%opts, qw(
+ iterations|i=s
+ direction|d=s
+ context|c=s
+ sizes|s=s
+ legend|key|l|k
+ help|usage
+ ) ) ;
- print FH join( '', @_ ) ;
-}
+ usage() unless $result ;
+ usage() if $opts{help} ;
-sub syswrite_join_file {
+ legend() if $opts{legend} ;
- my( $file_name ) = shift ;
+# set defaults
- local( *FH ) ;
+ $opts{direction} ||= 'both' ;
+ $opts{context} ||= 'both' ;
+ $opts{iterations} ||= -2 ;
+ $opts{sizes} ||= '500,10k,1m' ;
- open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
-
- syswrite( FH, join( '', @_ ) ) ;
-}
+ if ( $opts{direction} eq 'both' ) {
+
+ $opts{spew} = 1 ;
+ $opts{slurp} = 1 ;
+ }
+ elsif ( $opts{direction} eq 'in' ) {
-sub sysopen_syswrite_join_file {
+ $opts{slurp} = 1 ;
+
+ }
+ elsif ( $opts{direction} eq 'out' ) {
- my( $file_name ) = shift ;
+ $opts{spew} = 1 ;
+ }
+ else {
- local( *FH ) ;
+ usage( "Unknown direction: $opts{direction}" ) ;
+ }
- sysopen( FH, $file_name, O_WRONLY | O_CREAT ) ||
- carp "can't create $file_name $!" ;
+ if ( $opts{context} eq 'both' ) {
+
+ $opts{list} = 1 ;
+ $opts{scalar} = 1 ;
+ }
+ elsif ( $opts{context} eq 'scalar' ) {
- syswrite( FH, join( '', @_ ) ) ;
-}
+ $opts{scalar} = 1 ;
+
+ }
+ elsif ( $opts{context} eq 'list' ) {
-sub orig_write_file
-{
- my ($f, @data) = @_;
+ $opts{list} = 1 ;
+ }
+ else {
- local(*F);
+ usage( "Unknown context: $opts{context}" ) ;
+ }
- open(F, ">$f") || croak "open >$f: $!";
- (print F @data) || croak "write $f: $!";
- close(F) || croak "close $f: $!";
- return 1;
-}
+ if ( $opts{context} eq 'both' ) {
+
+ $opts{list} = 1 ;
+ $opts{scalar} = 1 ;
+ }
+ elsif ( $opts{context} eq 'scalar' ) {
+ $opts{scalar} = 1 ;
+
+ }
+ elsif ( $opts{context} eq 'list' ) {
-#######################
-# top level subs for script
+ $opts{list} = 1 ;
+ }
+ else {
-#######################
+ usage( "Unknown context: $opts{context}" ) ;
+ }
-sub parse_options {
+ foreach my $size ( split ',', ( $opts{sizes} ) ) {
- help() if $opts{help} ;
- key() if $opts{key} ;
+# check for valid size and suffix. grab both.
- unless( $opts{spew} || $opts{slurp} ) {
+ usage( "Illegal size: $size") unless $size =~ /^(\d+)([km])?$/ ;
- $opts{spew} = 1 ;
- $opts{slurp} = 1 ;
- }
+# handle suffix multipliers
- unless( $opts{list} || $opts{scalar} ) {
+ $size = $1 * (( $2 eq 'k' ) ? 1024 : 1024*1024) if $2 ;
- $opts{list} = 1 ;
- $opts{scalar} = 1 ;
+ push( @{$opts{size_list}}, $size ) ;
}
- $opts{sizes} = [split ',', ( $opts{sizes} || '10,100,1000' ) ];
-
- $opts{duration} ||= -2 ;
+#use Data::Dumper ;
+#print Dumper \%opts ;
}
-sub key {
+sub legend {
- print <<'KEY' ;
+ die <<'LEGEND' ;
+Legend for the Slurp Benchmark Entries
-Key to Slurp/Spew Benchmarks
+In all cases below 'FS' or 'F::S' means the current File::Slurp module
+is being used in the benchmark. The full name and description will say
+which options are being used.
-
-Write a list of lines to a file
+These benchmarks write a list of lines to a file. Use the direction option
+of 'out' or 'both' and the context option is 'list' or 'both'.
Key Description/Source
--- ------------------
+ FS::write_file Current F::S write_file
+ FS::write_file Aref Current F::S write_file on array ref of data
+ print Open a file and call print() on the list data
+ print/join Open a file and call print() on the joined
+ list data
+ syswrite/join Open a file, call syswrite on joined list data
+ sysopen/syswrite Sysopen a file, call syswrite on joined
+ list data
+ original write_file write_file code from original File::Slurp
+ (pre-version 9999.*)
+
+LEGEND
+}
- FS:write_file Current File::Slurp::write_file
- FS:write_file_ref Current File::Slurp::write_file (scalar ref)
- print Open a file and call print()
- syswrite/join Open a file, call syswrite on joined lines
- sysopen/syswrite Sysopen a file, call syswrite on joined lines
- original write_file Original (pre 9999.*) File::Slurp::write_file
-
-
-KEY
+sub usage {
- exit ;
-}
+ my( $err ) = @_ ;
-sub help {
+ $err ||= '' ;
die <<DIE ;
+$err
+Usage: $0 [--iterations=<iter>] [--direction=<dir>] [--context=<con>]
+ [--sizes=<size_list>] [--legend] [--help]
-Usage: $0 [--list] [--scalar] [--slurp] [--spew]
- [--sizes=10,100] [--help]
+ --iterations=<iter> Run the benchmarks this many iterations
+ -i=<iter> A positive number is iteration count,
+ a negative number is minimum CPU time in
+ seconds. Default is -2 (run for 2 CPU seconds).
- --list Run the list context benchmarks
- --scalar Run the scalar context benchmarks
- Those default to on unless one is set
+ --direction=<dir> Which direction to slurp: 'in', 'out' or 'both'.
+ -d=<dir> Default is 'both'.
- --slurp Run the slurp benchmarks
- --spew Run the spew benchmarks
- Those default to on unless one is set
+ --context=<con> Which context is used for slurping: 'list',
+ -c=<con> 'scalar' or 'both'. Default is 'both'.
- --sizes Comma separated list of file sizes to benchmark
- Defaults to 10,100,1000
+ --sizes=<size_list> What sizes will be used in slurping (either
+ -s=<size_list> direction). This is a comma separated list of
+ integers. You can use 'k' or 'm' as suffixes
+ for 1024 and 1024**2. Default is '500,1k,1m'.
- --key Print the benchmark names and code orig_ins
-
- --help Print this help text
+ --legend Print out a legend of all the benchmark entries.
+ --key
+ -l
+ -k
+ --help Print this help text
+ --usage
DIE
}
-
__END__
projects / urisagit/Perl-Docs.git / blobdiff