Commit | Line | Data |
635c7876 |
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 | } |