Dogcows Code - chaz/p5-CGI-Ex/blob - samples/benchmark/bench_conf_readers.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw($PLACEHOLDER);
   5 use Benchmark qw(cmpthese timethese);
   6 use CGI::Ex::Conf;
   7 use POSIX qw(tmpnam);
   8
   9 $PLACEHOLDER = chr(186).'~'.chr(186);
  10
  11 my $n = -2;
  12
  13 my $cob   = CGI::Ex::Conf->new;
  14 my %files = ();
  15
  16 ###----------------------------------------------------------------###
  17
  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
  28
  29 my $str = '{
  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"},
  43 }';
  44
  45 my $str = '[
  46   foo     => [key1 => "bar",   key2 => "ralph"],
  47   pass    => [key1 => "word",  key2 => "ralph"],
  48   garbage => [key1 => "can",   key2 => "ralph"],
  49   mighty  => [key1 => "ducks", key2 => "ralph"],
  50   quack   => [key1 => "moo",   key2 => "ralph"],
  51   one1    => [key1 => "val1",  key2 => "ralph"],
  52   one2    => [key1 => "val2",  key2 => "ralph"],
  53   one3    => [key1 => "val3",  key2 => "ralph"],
  54   one4    => [key1 => "val4",  key2 => "ralph"],
  55   one5    => [key1 => "val5",  key2 => "ralph"],
  56   one6    => [key1 => "val6",  key2 => "ralph"],
  57   one7    => [key1 => "val7",  key2 => "ralph"],
  58   one8    => [key1 => "val8",  key2 => "ralph"],
  59   foo     => [key1 => "bar",   key2 => "ralph"],
  60   pass    => [key1 => "word",  key2 => "ralph"],
  61   garbage => [key1 => "can",   key2 => "ralph"],
  62   mighty  => [key1 => "ducks", key2 => "ralph"],
  63   quack   => [key1 => "moo",   key2 => "ralph"],
  64   one1    => [key1 => "val1",  key2 => "ralph"],
  65   one2    => [key1 => "val2",  key2 => "ralph"],
  66   one3    => [key1 => "val3",  key2 => "ralph"],
  67   one4    => [key1 => "val4",  key2 => "ralph"],
  68   one5    => [key1 => "val5",  key2 => "ralph"],
  69   one6    => [key1 => "val6",  key2 => "ralph"],
  70   one7    => [key1 => "val7",  key2 => "ralph"],
  71   one8    => [key1 => "val8",  key2 => "ralph"],
  72   foo     => [key1 => "bar",   key2 => "ralph"],
  73   pass    => [key1 => "word",  key2 => "ralph"],
  74   garbage => [key1 => "can",   key2 => "ralph"],
  75   mighty  => [key1 => "ducks", key2 => "ralph"],
  76   quack   => [key1 => "moo",   key2 => "ralph"],
  77   one1    => [key1 => "val1",  key2 => "ralph"],
  78   one2    => [key1 => "val2",  key2 => "ralph"],
  79   one3    => [key1 => "val3",  key2 => "ralph"],
  80   one4    => [key1 => "val4",  key2 => "ralph"],
  81   one5    => [key1 => "val5",  key2 => "ralph"],
  82   one6    => [key1 => "val6",  key2 => "ralph"],
  83   one7    => [key1 => "val7",  key2 => "ralph"],
  84   one8    => [key1 => "val8",  key2 => "ralph"],
  85   foo     => [key1 => "bar",   key2 => "ralph"],
  86   pass    => [key1 => "word",  key2 => "ralph"],
  87   garbage => [key1 => "can",   key2 => "ralph"],
  88   mighty  => [key1 => "ducks", key2 => "ralph"],
  89   quack   => [key1 => "moo",   key2 => "ralph"],
  90   one1    => [key1 => "val1",  key2 => "ralph"],
  91   one2    => [key1 => "val2",  key2 => "ralph"],
  92   one3    => [key1 => "val3",  key2 => "ralph"],
  93   one4    => [key1 => "val4",  key2 => "ralph"],
  94   one5    => [key1 => "val5",  key2 => "ralph"],
  95   one6    => [key1 => "val6",  key2 => "ralph"],
  96   one7    => [key1 => "val7",  key2 => "ralph"],
  97   one8    => [key1 => "val8",  key2 => "ralph"],
  98   foo     => [key1 => "bar",   key2 => "ralph"],
  99   pass    => [key1 => "word",  key2 => "ralph"],
 100   garbage => [key1 => "can",   key2 => "ralph"],
 101   mighty  => [key1 => "ducks", key2 => "ralph"],
 102   quack   => [key1 => "moo",   key2 => "ralph"],
 103   one1    => [key1 => "val1",  key2 => "ralph"],
 104   one2    => [key1 => "val2",  key2 => "ralph"],
 105   one3    => [key1 => "val3",  key2 => "ralph"],
 106   one4    => [key1 => "val4",  key2 => "ralph"],
 107   one5    => [key1 => "val5",  key2 => "ralph"],
 108   one6    => [key1 => "val6",  key2 => "ralph"],
 109   one7    => [key1 => "val7",  key2 => "ralph"],
 110   one8    => [key1 => "val8",  key2 => "ralph"],
 111   foo     => [key1 => "bar",   key2 => "ralph"],
 112   pass    => [key1 => "word",  key2 => "ralph"],
 113   garbage => [key1 => "can",   key2 => "ralph"],
 114   mighty  => [key1 => "ducks", key2 => "ralph"],
 115   quack   => [key1 => "moo",   key2 => "ralph"],
 116   one1    => [key1 => "val1",  key2 => "ralph"],
 117   one2    => [key1 => "val2",  key2 => "ralph"],
 118   one3    => [key1 => "val3",  key2 => "ralph"],
 119   one4    => [key1 => "val4",  key2 => "ralph"],
 120   one5    => [key1 => "val5",  key2 => "ralph"],
 121   one6    => [key1 => "val6",  key2 => "ralph"],
 122   one7    => [key1 => "val7",  key2 => "ralph"],
 123   one8    => [key1 => "val8",  key2 => "ralph"],
 124   foo     => [key1 => "bar",   key2 => "ralph"],
 125   pass    => [key1 => "word",  key2 => "ralph"],
 126   garbage => [key1 => "can",   key2 => "ralph"],
 127   mighty  => [key1 => "ducks", key2 => "ralph"],
 128   quack   => [key1 => "moo",   key2 => "ralph"],
 129   one1    => [key1 => "val1",  key2 => "ralph"],
 130   one2    => [key1 => "val2",  key2 => "ralph"],
 131   one3    => [key1 => "val3",  key2 => "ralph"],
 132   one4    => [key1 => "val4",  key2 => "ralph"],
 133   one5    => [key1 => "val5",  key2 => "ralph"],
 134   one6    => [key1 => "val6",  key2 => "ralph"],
 135   one7    => [key1 => "val7",  key2 => "ralph"],
 136   one8    => [key1 => "val8",  key2 => "ralph"],
 137   foo     => [key1 => "bar",   key2 => "ralph"],
 138   pass    => [key1 => "word",  key2 => "ralph"],
 139   garbage => [key1 => "can",   key2 => "ralph"],
 140   mighty  => [key1 => "ducks", key2 => "ralph"],
 141   quack   => [key1 => "moo",   key2 => "ralph"],
 142   one1    => [key1 => "val1",  key2 => "ralph"],
 143   one2    => [key1 => "val2",  key2 => "ralph"],
 144   one3    => [key1 => "val3",  key2 => "ralph"],
 145   one4    => [key1 => "val4",  key2 => "ralph"],
 146   one5    => [key1 => "val5",  key2 => "ralph"],
 147   one6    => [key1 => "val6",  key2 => "ralph"],
 148   one7    => [key1 => "val7",  key2 => "ralph"],
 149   one8    => [key1 => "val8",  key2 => "ralph"],
 150   foo     => [key1 => "bar",   key2 => "ralph"],
 151   pass    => [key1 => "word",  key2 => "ralph"],
 152   garbage => [key1 => "can",   key2 => "ralph"],
 153   mighty  => [key1 => "ducks", key2 => "ralph"],
 154   quack   => [key1 => "moo",   key2 => "ralph"],
 155   one1    => [key1 => "val1",  key2 => "ralph"],
 156   one2    => [key1 => "val2",  key2 => "ralph"],
 157   one3    => [key1 => "val3",  key2 => "ralph"],
 158   one4    => [key1 => "val4",  key2 => "ralph"],
 159   one5    => [key1 => "val5",  key2 => "ralph"],
 160   one6    => [key1 => "val6",  key2 => "ralph"],
 161   one7    => [key1 => "val7",  key2 => "ralph"],
 162   one8    => [key1 => "val8",  key2 => "ralph"],
 163   foo     => [key1 => "bar",   key2 => "ralph"],
 164   pass    => [key1 => "word",  key2 => "ralph"],
 165   garbage => [key1 => "can",   key2 => "ralph"],
 166   mighty  => [key1 => "ducks", key2 => "ralph"],
 167   quack   => [key1 => "moo",   key2 => "ralph"],
 168   one1    => [key1 => "val1",  key2 => "ralph"],
 169   one2    => [key1 => "val2",  key2 => "ralph"],
 170   one3    => [key1 => "val3",  key2 => "ralph"],
 171   one4    => [key1 => "val4",  key2 => "ralph"],
 172   one5    => [key1 => "val5",  key2 => "ralph"],
 173   one6    => [key1 => "val6",  key2 => "ralph"],
 174   one7    => [key1 => "val7",  key2 => "ralph"],
 175   one8    => [key1 => "val8",  key2 => "ralph"],
 176   foo     => [key1 => "bar",   key2 => "ralph"],
 177   pass    => [key1 => "word",  key2 => "ralph"],
 178   garbage => [key1 => "can",   key2 => "ralph"],
 179   mighty  => [key1 => "ducks", key2 => "ralph"],
 180   quack   => [key1 => "moo",   key2 => "ralph"],
 181   one1    => [key1 => "val1",  key2 => "ralph"],
 182   one2    => [key1 => "val2",  key2 => "ralph"],
 183   one3    => [key1 => "val3",  key2 => "ralph"],
 184   one4    => [key1 => "val4",  key2 => "ralph"],
 185   one5    => [key1 => "val5",  key2 => "ralph"],
 186   one6    => [key1 => "val6",  key2 => "ralph"],
 187   one7    => [key1 => "val7",  key2 => "ralph"],
 188   one8    => [key1 => "val8",  key2 => "ralph"],
 189 ]';
 190
 191 ###----------------------------------------------------------------###
 192
 193 #           Rate   yaml  yaml2    xml g_conf     pl    sto   sto2  yaml3
 194 #yaml      431/s     --    -2%   -61%   -91%   -94%   -97%   -98%  -100%
 195 #yaml2     438/s     2%     --   -60%   -91%   -94%   -97%   -98%  -100%
 196 #xml      1099/s   155%   151%     --   -78%   -85%   -92%   -94%   -99%
 197 #g_conf   4990/s  1057%  1038%   354%     --   -33%   -64%   -72%   -96%
 198 #pl       7492/s  1637%  1609%   582%    50%     --   -46%   -58%   -93%
 199 #sto     13937/s  3130%  3078%  1169%   179%    86%     --   -22%   -88%
 200 #sto2    17925/s  4055%  3988%  1532%   259%   139%    29%     --   -84%
 201 #yaml3  114429/s 26423% 25996% 10316%  2193%  1427%   721%   538%     -- # memory
 202
 203 #$str = '{
 204 #  foo     => "bar",
 205 #  pass    => "word",
 206 #  garbage => "can",
 207 #  mighty  => "ducks",
 208 #  quack   => "moo",
 209 #  one1    => "val1",
 210 #  one2    => "val2",
 211 #  one3    => "val3",
 212 #  one4    => "val4",
 213 #  one5    => "val5",
 214 #  one6    => "val6",
 215 #  one7    => "val7",
 216 #  one8    => "val8",
 217 #}';
 218
 219 ###----------------------------------------------------------------###
 220
 221 my $conf = eval $str;
 222
 223 my %TESTS = ();
 224
 225 ### do perl
 226 my $file = tmpnam(). '.pl';
 227 open OUT, ">$file";
 228 print OUT $str;
 229 close OUT;
 230 $TESTS{pl} = sub {
 231   my $hash = $cob->read_ref($file);
 232 };
 233 $files{pl} = $file;
 234
 235 ### do a generic conf_write
 236 #my $file2 = tmpnam(). '.g_conf';
 237 #&generic_conf_write($file2, $conf);
 238 #local $CGI::Ex::Conf::EXT_READERS{g_conf} = \&generic_conf_read;
 239 #$TESTS{g_conf} = sub {
 240 #  my $hash = $cob->read_ref($file2);
 241 #};
 242 #$files{g_conf} = $file2;
 243
 244
 245 if (eval {require JSON}) {
 246   my $_file = tmpnam(). '.json';
 247   my $str = JSON::objToJson($conf, {pretty => 1, indent => 2});
 248   open(my $fh, ">$_file");
 249   print $fh $str;
 250   $TESTS{json} = sub {
 251     my $hash = $cob->read_ref($_file);
 252   };
 253   $TESTS{json2} = sub {
 254     open(my $fh, "<$_file") || die "Couldn't open file: $!";
 255     read($fh, my $str, -s $_file);
 256     my $hash = JSON::jsonToObj($str);
 257   };
 258   $files{json} = $_file;
 259 }
 260
 261
 262 ### load in the rest of the tests that we support
 263 if (eval {require Storable}) {
 264   my $_file = tmpnam(). '.sto';
 265   &Storable::store($conf, $_file);
 266   $TESTS{sto} = sub {
 267     my $hash = $cob->read_ref($_file);
 268   };
 269   $files{sto} = $_file;
 270 }
 271
 272 if (eval {require Storable}) {
 273   my $_file = tmpnam(). '.sto2';
 274   &Storable::store($conf, $_file);
 275   $TESTS{sto2} = sub {
 276     my $hash = &Storable::retrieve($_file);
 277   };
 278   $files{sto2} = $_file;
 279 }
 280
 281 if (eval {require YAML}) {
 282   my $_file = tmpnam(). '.yaml';
 283   &YAML::DumpFile($_file, $conf);
 284   $TESTS{yaml} = sub {
 285     my $hash = $cob->read_ref($_file);
 286   };
 287   $files{yaml} = $_file;
 288 }
 289
 290 if (eval {require YAML}) {
 291   my $_file = tmpnam(). '.yaml2';
 292   &YAML::DumpFile($_file, $conf);
 293   $TESTS{yaml2} = sub {
 294     my $hash = &YAML::LoadFile($_file);
 295   };
 296   $files{yaml2} = $_file;
 297 }
 298
 299 if (eval {require YAML}) {
 300   my $_file = tmpnam(). '.yaml';
 301   &YAML::DumpFile($_file, $conf);
 302   $cob->preload_files($_file);
 303   $TESTS{yaml3} = sub {
 304     my $hash = $cob->read_ref($_file);
 305   };
 306   $files{yaml3} = $_file;
 307 }
 308
 309 if (eval {require Config::IniHash}) {
 310   my $_file = tmpnam(). '.ini';
 311   &Config::IniHash::WriteINI($_file, $conf);
 312   $TESTS{ini} = sub {
 313     local $^W = 0;
 314     my $hash = $cob->read_ref($_file);
 315   };
 316   $files{ini} = $_file;
 317 }
 318
 319 if (eval {require XML::Simple}) {
 320   my $_file = tmpnam(). '.xml';
 321   my $xml = XML::Simple->new->XMLout($conf);
 322   open  OUT, ">$_file" || die $!;
 323   print OUT $xml;
 324   close OUT;
 325   $TESTS{xml} = sub {
 326     my $hash = $cob->read_ref($_file);
 327   };
 328   $files{xml} = $_file;
 329 }
 330
 331 ### tell file locations
 332 foreach my $key (sort keys %files) {
 333   print "$key => $files{$key}\n";
 334 }
 335
 336 cmpthese timethese ($n, \%TESTS);
 337
 338 ### comment out this line to inspect files
 339 unlink $_ foreach values %files;
 340
 341 ###----------------------------------------------------------------###
 342
 343 sub generic_conf_read {
 344   my $_file = shift || die "No filename supplied";
 345   my $sep_by_newlines = ($_[0] && lc($_[0]) eq 'sep_by_newlines') ? 1 : 0;
 346
 347   ### fh will now lose scope and close itself if necessary
 348   my $FH = do { local *FH; *FH };
 349   open ($FH, $_file) || return {};
 350
 351   my $x = 0;
 352   my $conf = {};
 353   my $key  = '';
 354   my $val;
 355   my $line;
 356   my ($is_array,$is_hash,$is_multiline);
 357   my $order;
 358   $order = [] if wantarray;
 359
 360   while( defined($line = <$FH>) ){
 361     last if ! defined $line;
 362     last if $x++ > 10000;
 363
 364     next if index($line,'#') == 0;
 365
 366     if ($line =~ /^\s/ && ($is_multiline || $line ne "\n")){
 367       next if ! length($key);
 368       $conf->{$key} .= $line;
 369       $is_multiline = 1;
 370
 371     }else{
 372       ### duplicate trim section
 373       if( length($key) ){
 374         $conf->{$key} =~ s/\s+$//;
 375         if( $is_array || $is_hash ){
 376           $conf->{$key} =~ s/^\s+//;
 377           my $urldec = (index($conf->{$key},'%')>-1 || index($conf->{$key},'+')>-1);
 378           my @pieces;
 379           if ($sep_by_newlines) {
 380             @pieces = split(/\s*\n\s*/,$conf->{$key});
 381             @pieces = map {split(/\s+/,$_,2)} @pieces if $is_hash;
 382           } else {
 383             @pieces = split(/\s+/,$conf->{$key});
 384           }
 385           if( $urldec ){
 386             foreach my $_val (@pieces){
 387               $_val =~ y/+/ / if ! $sep_by_newlines;
 388               $_val =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
 389             }
 390           }
 391           if( $is_array ){
 392             foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
 393             $conf->{$key} = \@pieces;
 394           }elsif( $is_hash ){
 395             foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
 396             shift(@pieces) if scalar(@pieces) % 2;
 397             $conf->{$key} = {@pieces};
 398           }
 399         }elsif( ! $is_multiline ){
 400           $conf->{$key} =~ y/+/ / if ! $sep_by_newlines;
 401           $conf->{$key} =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
 402         }
 403       }
 404
 405       ($key,$val) = split(/\s+/,$line,2);
 406       $is_array = 0;
 407       $is_hash = 0;
 408       $is_multiline = 0;
 409       if (! length($key)) {
 410         next;
 411       } elsif (index($key,'array:') == 0) {
 412         $is_array = $key =~ s/^array://i;
 413       } elsif (index($key,'hash:') == 0) {
 414         $is_hash = $key =~ s/^hash://i;
 415       }
 416       $key =~ y/+/ / if ! $sep_by_newlines;
 417       $key =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
 418       $conf->{$key} = $val;
 419       push @$order, $key if $order;
 420     }
 421   }
 422
 423   ### duplicate trim section
 424   if( length($key) && defined($conf->{$key}) ){
 425     $conf->{$key} =~ s/\s+$//;
 426     if( $is_array || $is_hash ){
 427       $conf->{$key} =~ s/^\s+//;
 428       my $urldec = (index($conf->{$key},'%')>-1 || index($conf->{$key},'+')>-1);
 429       my @pieces;
 430       if ($sep_by_newlines) {
 431         @pieces = split(/\s*\n\s*/,$conf->{$key});
 432         @pieces = map {split(/\s+/,$_,2)} @pieces if $is_hash;
 433       } else {
 434         @pieces = split(/\s+/,$conf->{$key});
 435       }
 436       if( $urldec ){
 437         foreach my $_val (@pieces){
 438           $_val =~ y/+/ / if ! $sep_by_newlines;
 439           $_val =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
 440         }
 441       }
 442       if( $is_array ){
 443         foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
 444         $conf->{$key} = \@pieces;
 445       }elsif( $is_hash ){
 446         foreach (@pieces){ $_="" if index($_,$PLACEHOLDER)>-1 }
 447         shift(@pieces) if scalar(@pieces) % 2;
 448         $conf->{$key} = {@pieces};
 449       }
 450     }elsif( ! $is_multiline ){
 451       $conf->{$key} =~ y/+/ / if ! $sep_by_newlines;
 452       $conf->{$key} =~ s/%([a-f0-9]{2})/chr(hex($1))/egi;
 453     }
 454   }
 455
 456
 457   close($FH);
 458   return $order ? ($conf,$order) : $conf;
 459 }
 460
 461
 462 sub generic_conf_write{
 463   my $_file = shift || die "No filename supplied";
 464
 465   if (! @_) {
 466     return;
 467   }
 468
 469   my $new_conf = shift || die "Missing update hashref";
 470   return if ! keys %$new_conf;
 471
 472
 473   ### do we allow writing out hashes in a nice way
 474   my $sep_by_newlines = ($_[0] && lc($_[0]) eq 'sep_by_newlines') ? 1 : 0;
 475
 476   ### touch the file if necessary
 477   if( ! -e $_file ){
 478     open(TOUCH,">$_file") || die "Conf file \"$_file\" could not be opened for writing: $!";
 479     close(TOUCH);
 480   }
 481
 482   ### read old values
 483   my $conf = &generic_conf_read($_file) || {};
 484   my $key;
 485   my $val;
 486
 487   ### remove duplicates and undefs
 488   while (($key,$val) = each %$new_conf){
 489     $conf->{$key} = $new_conf->{$key};
 490   }
 491
 492   ### prepare output
 493   my $output = '';
 494   my $qr = qr/([^\ \!\"\$\&-\*\,-\~])/;
 495   foreach $key (sort keys %$conf){
 496     next if ! defined $conf->{$key};
 497     $val = delete $conf->{$key};
 498     $key =~ s/([^\ \!\"\$\&-\*\,-9\;-\~\/])/sprintf("%%%02X",ord($1))/eg;
 499     $key =~ tr/\ /+/;
 500     my $ref = ref($val);
 501     if( $ref ){
 502       if( $ref eq 'HASH' ){
 503         $output .= "hash:$key\n";
 504         foreach my $_key (sort keys %$val){
 505           my $_val = $val->{$_key};
 506           next if ! defined $_val;
 507           $_val =~ s/$qr/sprintf("%%%02X",ord($1))/ego;
 508           $_key =~ s/$qr/sprintf("%%%02X",ord($1))/ego;
 509           if ($sep_by_newlines) {
 510             $_val =~ s/^(\s)/sprintf("%%%02X",ord($1))/ego;
 511             $_val =~ s/(\s)$/sprintf("%%%02X",ord($1))/ego;
 512             $_key =~ s/\ /%20/g;
 513           } else {
 514             $_val =~ tr/\ /+/;
 515             $_key =~ tr/\ /+/;
 516           }
 517           $_val = $PLACEHOLDER if ! length($_val);
 518           $output .= "\t$_key\t$_val\n";
 519         }
 520       }elsif( $ref eq 'ARRAY' ){
 521         $output .= "array:$key\n";
 522         foreach (@$val){
 523           my $_val = $_;
 524           $_val =~ s/$qr/sprintf("%%%02X",ord($1))/ego;
 525           if ($sep_by_newlines) {
 526             $_val =~ s/^(\s)/sprintf("%%%02X",ord($1))/ego;
 527             $_val =~ s/(\s)$/sprintf("%%%02X",ord($1))/ego;
 528           } else {
 529             $_val =~ tr/\ /+/;
 530           }
 531           $_val = $PLACEHOLDER if ! length($_val);
 532           $output .= "\t$_val\n";
 533         }
 534       }else{
 535         $output .= "$key\tbless('$val','$ref')\n"; # stringify the ref
 536       }
 537     }else{
 538       if( $val =~ /\n/ ){ # multiline values that are indented properly don't need encoding
 539         if( $val =~ /^\s/ || $val =~ /\s$/ || $val =~ /\n\n/ || $val =~ /\n([^\ \t])/ ){
 540           if ($sep_by_newlines) {
 541             $val =~ s/([^\!\"\$\&-\~])/sprintf("%%%02X",ord($1))/eg;
 542           } else {
 543             $val =~ s/([^\ \!\"\$\&-\*\,-\~])/sprintf("%%%02X",ord($1))/eg;
 544             $val =~ y/ /+/;
 545           }
 546         }
 547       }else{
 548         $val =~ s/([^\ \t\!\"\$\&-\*\,-\~])/sprintf("%%%02X",ord($1))/eg;
 549         $val =~ s/^(\s)/sprintf("%%%02X",ord($1))/eg;
 550         $val =~ s/(\s)$/sprintf("%%%02X",ord($1))/eg;
 551       }
 552       $output .= "$key\t$val\n";
 553     }
 554   }
 555
 556   open (CONF,"+<$_file") || die "Could not open the file for writing ($_file) -- [$!]";
 557   print CONF $output;
 558   truncate CONF, length($output);
 559   close CONF;
 560
 561   return 1;
 562 }
 563
 564 1;
 565