]>
Dogcows Code - chaz/p5-CGI-Ex/blob - samples/benchmark/bench_conf_readers.pl
4 use vars
qw($PLACEHOLDER);
5 use Benchmark
qw(cmpthese);
9 $PLACEHOLDER = chr(186).'~'.chr(186);
13 my $cob = CGI
::Ex
::Conf-
>new;
16 ###----------------------------------------------------------------###
18 # Rate yaml2 yaml xml ini g_conf pl sto sto2 yaml3
19 #yaml2 159/s -- -1% -72% -80% -91% -95% -98% -98% -100%
20 #yaml 160/s 1% -- -72% -80% -91% -95% -98% -98% -100%
21 #xml 565/s 255% 253% -- -28% -68% -84% -93% -94% -100%
22 #ini 785/s 393% 391% 39% -- -55% -78% -90% -91% -99%
23 #g_conf 1756/s 1004% 998% 211% 124% -- -50% -78% -80% -98%
24 #pl 3524/s 2115% 2103% 524% 349% 101% -- -55% -61% -97%
25 #sto 7838/s 4826% 4799% 1288% 898% 346% 122% -- -12% -93%
26 #sto2 8924/s 5508% 5477% 1480% 1037% 408% 153% 14% -- -92%
27 #yaml3 113328/s 71115% 70730% 19961% 14336% 6353% 3116% 1346% 1170% -- #memory
30 foo => {key1 => "bar", key2 => "ralph"},
31 pass => {key1 => "word", key2 => "ralph"},
32 garbage => {key1 => "can", key2 => "ralph"},
33 mighty => {key1 => "ducks", key2 => "ralph"},
34 quack => {key1 => "moo", key2 => "ralph"},
35 one1 => {key1 => "val1", key2 => "ralph"},
36 one2 => {key1 => "val2", key2 => "ralph"},
37 one3 => {key1 => "val3", key2 => "ralph"},
38 one4 => {key1 => "val4", key2 => "ralph"},
39 one5 => {key1 => "val5", key2 => "ralph"},
40 one6 => {key1 => "val6", key2 => "ralph"},
41 one7 => {key1 => "val7", key2 => "ralph"},
42 one8 => {key1 => "val8", key2 => "ralph"},
45 ###----------------------------------------------------------------###
47 # Rate yaml yaml2 xml g_conf pl sto sto2 yaml3
48 #yaml 431/s -- -2% -61% -91% -94% -97% -98% -100%
49 #yaml2 438/s 2% -- -60% -91% -94% -97% -98% -100%
50 #xml 1099/s 155% 151% -- -78% -85% -92% -94% -99%
51 #g_conf 4990/s 1057% 1038% 354% -- -33% -64% -72% -96%
52 #pl 7492/s 1637% 1609% 582% 50% -- -46% -58% -93%
53 #sto 13937/s 3130% 3078% 1169% 179% 86% -- -22% -88%
54 #sto2 17925/s 4055% 3988% 1532% 259% 139% 29% -- -84%
55 #yaml3 114429/s 26423% 25996% 10316% 2193% 1427% 721% 538% -- # memory
73 ###----------------------------------------------------------------###
80 my $file = tmpnam
(). '.pl';
85 my $hash = $cob->read_ref($file);
89 ### do a generic conf_write
90 my $file2 = tmpnam
(). '.g_conf';
91 &generic_conf_write
($file2, $conf);
92 local $CGI::Ex
::Conf
::EXT_READERS
{g_conf
} = \
&generic_conf_read
;
93 $TESTS{g_conf
} = sub {
94 my $hash = $cob->read_ref($file2);
96 $files{g_conf
} = $file2;
99 if (eval {require JSON
}) {
100 my $_file = tmpnam
(). '.json';
101 my $str = JSON
::objToJson
($conf, {pretty
=> 1, indent
=> 2});
102 open(my $fh, ">$_file");
105 my $hash = $cob->read_ref($_file);
107 $TESTS{json2
} = sub {
108 open(my $fh, "<$_file") || die "Couldn't open file: $!";
109 read($fh, my $str, -s
$_file);
110 my $hash = JSON
::jsonToObj
($str);
112 $files{json
} = $_file;
116 ### load in the rest of the tests that we support
117 if (eval {require Storable
}) {
118 my $_file = tmpnam
(). '.sto';
119 &Storable
::store
($conf, $_file);
121 my $hash = $cob->read_ref($_file);
123 $files{sto
} = $_file;
126 if (eval {require Storable
}) {
127 my $_file = tmpnam
(). '.sto2';
128 &Storable
::store
($conf, $_file);
130 my $hash = &Storable
::retrieve
($_file);
132 $files{sto2
} = $_file;
135 if (eval {require YAML
}) {
136 my $_file = tmpnam
(). '.yaml';
137 &YAML
::DumpFile
($_file, $conf);
139 my $hash = $cob->read_ref($_file);
141 $files{yaml
} = $_file;
144 if (eval {require YAML
}) {
145 my $_file = tmpnam
(). '.yaml2';
146 &YAML
::DumpFile
($_file, $conf);
147 $TESTS{yaml2
} = sub {
148 my $hash = &YAML
::LoadFile
($_file);
150 $files{yaml2
} = $_file;
153 if (eval {require YAML
}) {
154 my $_file = tmpnam
(). '.yaml';
155 &YAML
::DumpFile
($_file, $conf);
156 $cob->preload_files($_file);
157 $TESTS{yaml3
} = sub {
158 my $hash = $cob->read_ref($_file);
160 $files{yaml3
} = $_file;
163 if (eval {require Config
::IniHash
}) {
164 my $_file = tmpnam
(). '.ini';
165 &Config
::IniHash
::WriteINI
($_file, $conf);
168 my $hash = $cob->read_ref($_file);
170 $files{ini
} = $_file;
173 if (eval {require XML
::Simple
}) {
174 my $_file = tmpnam
(). '.xml';
175 my $xml = XML
::Simple-
>new->XMLout($conf);
176 open OUT
, ">$_file" || die $!;
180 my $hash = $cob->read_ref($_file);
182 $files{xml
} = $_file;
185 ### tell file locations
186 foreach my $key (sort keys %files) {
187 print "$key => $files{$key}\n";
190 cmpthese
($n, \
%TESTS);
192 ### comment out this line to inspect files
193 unlink $_ foreach values %files;
195 ###----------------------------------------------------------------###
197 sub generic_conf_read
{
198 my $_file = shift || die "No filename supplied";
199 my $sep_by_newlines = ($_[0] && lc($_[0]) eq 'sep_by_newlines') ? 1 : 0;
201 ### fh will now lose scope and close itself if necessary
202 my $FH = do { local *FH
; *FH
};
203 open ($FH, $_file) || return {};
210 my ($is_array,$is_hash,$is_multiline);
212 $order = [] if wantarray;
214 while( defined($line = <$FH>) ){
215 last if ! defined $line;
216 last if $x++ > 10000;
218 next if index($line,'#') == 0;
220 if ($line =~ /^\s/ && ($is_multiline || $line ne "\n")){
221 next if ! length($key);
222 $conf->{$key} .= $line;
226 ### duplicate trim section
228 $conf->{$key} =~ s/\s+$//;
229 if( $is_array || $is_hash ){
230 $conf->{$key} =~ s/^\s+//;
231 my $urldec = (index($conf->{$key},'%')>-1 || index($conf->{$key},'+')>-1);
233 if ($sep_by_newlines) {
234 @pieces = split(/\s*\n\s*/,$conf->{$key});
235 @pieces = map {split(/\s+/,$_,2)} @pieces if $is_hash;
237 @pieces = split(/\s+/,$conf->{$key});
240 foreach my $_val (@pieces){
241 $_val =~ y/+/ / if ! $sep_by_newlines;
242 $_val =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
246 foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
247 $conf->{$key} = \
@pieces;
249 foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
250 shift(@pieces) if scalar(@pieces) % 2;
251 $conf->{$key} = {@pieces};
253 }elsif( ! $is_multiline ){
254 $conf->{$key} =~ y/+/ / if ! $sep_by_newlines;
255 $conf->{$key} =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
259 ($key,$val) = split(/\s+/,$line,2);
263 if (! length($key)) {
265 } elsif (index($key,'array:') == 0) {
266 $is_array = $key =~ s/^array://i;
267 } elsif (index($key,'hash:') == 0) {
268 $is_hash = $key =~ s/^hash://i;
270 $key =~ y/+/ / if ! $sep_by_newlines;
271 $key =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
272 $conf->{$key} = $val;
273 push @$order, $key if $order;
277 ### duplicate trim section
278 if( length($key) && defined($conf->{$key}) ){
279 $conf->{$key} =~ s/\s+$//;
280 if( $is_array || $is_hash ){
281 $conf->{$key} =~ s/^\s+//;
282 my $urldec = (index($conf->{$key},'%')>-1 || index($conf->{$key},'+')>-1);
284 if ($sep_by_newlines) {
285 @pieces = split(/\s*\n\s*/,$conf->{$key});
286 @pieces = map {split(/\s+/,$_,2)} @pieces if $is_hash;
288 @pieces = split(/\s+/,$conf->{$key});
291 foreach my $_val (@pieces){
292 $_val =~ y/+/ / if ! $sep_by_newlines;
293 $_val =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
297 foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
298 $conf->{$key} = \
@pieces;
300 foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
301 shift(@pieces) if scalar(@pieces) % 2;
302 $conf->{$key} = {@pieces};
304 }elsif( ! $is_multiline ){
305 $conf->{$key} =~ y/+/ / if ! $sep_by_newlines;
306 $conf->{$key} =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
312 return $order ? ($conf,$order) : $conf;
316 sub generic_conf_write
{
317 my $_file = shift || die "No filename supplied";
323 my $new_conf = shift || die "Missing update hashref";
324 return if ! keys %$new_conf;
327 ### do we allow writing out hashes in a nice way
328 my $sep_by_newlines = ($_[0] && lc($_[0]) eq 'sep_by_newlines') ? 1 : 0;
330 ### touch the file if necessary
332 open(TOUCH
,">$_file") || die "Conf file \"$_file\" could not be opened for writing: $!";
337 my $conf = &generic_conf_read
($_file) || {};
341 ### remove duplicates and undefs
342 while (($key,$val) = each %$new_conf){
343 $conf->{$key} = $new_conf->{$key};
348 my $qr = qr/([^\ \!\"\$\&-\*\,-\~])/;
349 foreach $key (sort keys %$conf){
350 next if ! defined $conf->{$key};
351 $val = delete $conf->{$key};
352 $key =~ s/([^\ \!\"\$\&-\*\,-9\;-\~\/])/sprintf
("%%%02X",ord($1))/eg
;
356 if( $ref eq 'HASH' ){
357 $output .= "hash:$key\n";
358 foreach my $_key (sort keys %$val){
359 my $_val = $val->{$_key};
360 next if ! defined $_val;
361 $_val =~ s/$qr/sprintf("%%%02X",ord($1))/ego;
362 $_key =~ s/$qr/sprintf("%%%02X",ord($1))/ego;
363 if ($sep_by_newlines) {
364 $_val =~ s/^(\s)/sprintf("%%%02X",ord($1))/ego;
365 $_val =~ s/(\s)$/sprintf("%%%02X",ord($1))/ego;
371 $_val = $PLACEHOLDER if ! length($_val);
372 $output .= "\t$_key\t$_val\n";
374 }elsif( $ref eq 'ARRAY' ){
375 $output .= "array:$key\n";
378 $_val =~ s/$qr/sprintf("%%%02X",ord($1))/ego;
379 if ($sep_by_newlines) {
380 $_val =~ s/^(\s)/sprintf("%%%02X",ord($1))/ego;
381 $_val =~ s/(\s)$/sprintf("%%%02X",ord($1))/ego;
385 $_val = $PLACEHOLDER if ! length($_val);
386 $output .= "\t$_val\n";
389 $output .= "$key\tbless('$val','$ref')\n"; # stringify the ref
392 if( $val =~ /\n/ ){ # multiline values that are indented properly don't need encoding
393 if( $val =~ /^\s/ || $val =~ /\s$/ || $val =~ /\n\n/ || $val =~ /\n([^\ \t])/ ){
394 if ($sep_by_newlines) {
395 $val =~ s/([^\!\"\$\&-\~])/sprintf("%%%02X",ord($1))/eg;
397 $val =~ s/([^\ \!\"\$\&-\*\,-\~])/sprintf("%%%02X",ord($1))/eg;
402 $val =~ s/([^\ \t\!\"\$\&-\*\,-\~])/sprintf("%%%02X",ord($1))/eg;
403 $val =~ s/^(\s)/sprintf("%%%02X",ord($1))/eg;
404 $val =~ s/(\s)$/sprintf("%%%02X",ord($1))/eg;
406 $output .= "$key\t$val\n";
410 open (CONF
,"+<$_file") || die "Could not open the file for writing ($_file) -- [$!]";
412 truncate CONF
, length($output);
This page took 0.06535 seconds and 4 git commands to generate.