Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Conf.pm

   1 package CGI::Ex::Conf;
   2
   3 =head1 NAME
   4
   5 CGI::Ex::Conf - Conf Reader/Writer for many different data format types
   6
   7 =cut
   8
   9 ###----------------------------------------------------------------###
  10 #  Copyright 2007 - Paul Seamons                                     #
  11 #  Distributed under the Perl Artistic License without warranty      #
  12 ###----------------------------------------------------------------###
  13
  14 use strict;
  15 use base qw(Exporter);
  16 use Carp qw(croak);
  17 use vars qw($VERSION
  18             @DEFAULT_PATHS
  19             $DEFAULT_EXT
  20             %EXT_READERS
  21             %EXT_WRITERS
  22             $DIRECTIVE
  23             $IMMUTABLE_QR
  24             $IMMUTABLE_KEY
  25             %CACHE
  26             $HTML_KEY
  27             @EXPORT_OK
  28             $NO_WARN_ON_FAIL
  29             );
  30 @EXPORT_OK = qw(conf_read conf_write in_cache);
  31
  32 $VERSION = '2.27';
  33
  34 $DEFAULT_EXT = 'conf';
  35
  36 %EXT_READERS = (''         => \&read_handler_yaml,
  37                 'conf'     => \&read_handler_yaml,
  38                 'json'     => \&read_handler_json,
  39                 'val_json' => \&read_handler_json,
  40                 'ini'      => \&read_handler_ini,
  41                 'pl'       => \&read_handler_pl,
  42                 'sto'      => \&read_handler_storable,
  43                 'storable' => \&read_handler_storable,
  44                 'val'      => \&read_handler_yaml,
  45                 'xml'      => \&read_handler_xml,
  46                 'yaml'     => \&read_handler_yaml,
  47                 'yml'      => \&read_handler_yaml,
  48                 'html'     => \&read_handler_html,
  49                 'htm'      => \&read_handler_html,
  50                 );
  51
  52 %EXT_WRITERS = (''         => \&write_handler_yaml,
  53                 'conf'     => \&write_handler_yaml,
  54                 'ini'      => \&write_handler_ini,
  55                 'json'     => \&write_handler_json,
  56                 'val_json' => \&write_handler_json,
  57                 'pl'       => \&write_handler_pl,
  58                 'sto'      => \&write_handler_storable,
  59                 'storable' => \&write_handler_storable,
  60                 'val'      => \&write_handler_yaml,
  61                 'xml'      => \&write_handler_xml,
  62                 'yaml'     => \&write_handler_yaml,
  63                 'yml'      => \&write_handler_yaml,
  64                 'html'     => \&write_handler_html,
  65                 'htm'      => \&write_handler_html,
  66                 );
  67
  68 ### $DIRECTIVE controls how files are looked for when namespaces are not absolute.
  69 ### If directories 1, 2 and 3 are passed and each has a config file
  70 ### LAST would return 3, FIRST would return 1, and MERGE will
  71 ### try to put them all together.  Merge behavior of hashes
  72 ### is determined by $IMMUTABLE_\w+ variables.
  73 $DIRECTIVE = 'LAST'; # LAST, MERGE, FIRST
  74
  75 $IMMUTABLE_QR = qr/_immu(?:table)?$/i;
  76
  77 $IMMUTABLE_KEY = 'immutable';
  78
  79 ###----------------------------------------------------------------###
  80
  81 sub new {
  82   my $class = shift || __PACKAGE__;
  83   my $args  = shift || {};
  84
  85   return bless {%$args}, $class;
  86 }
  87
  88 sub paths {
  89   my $self = shift;
  90   return $self->{paths} ||= \@DEFAULT_PATHS;
  91 }
  92
  93 ###----------------------------------------------------------------###
  94
  95 sub conf_read {
  96   my $file = shift;
  97   my $args = shift || {};
  98   my $ext;
  99
 100   ### they passed the right stuff already
 101   if (ref $file) {
 102     if (UNIVERSAL::isa($file, 'SCALAR')) {
 103       if ($$file =~ /^\s*</) {
 104         return html_parse_yaml_load($$file, $args); # allow for ref to a YAML string
 105       } else {
 106         return yaml_load($$file); # allow for ref to a YAML string
 107       }
 108     } else {
 109       return $file;
 110     }
 111
 112   ### allow for a pre-cached reference
 113   } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
 114     return $CACHE{$file};
 115
 116   ### if contains a newline - treat it as a YAML string
 117   } elsif (index($file,"\n") != -1) {
 118     return yaml_load($file);
 119
 120   ### otherwise base it off of the file extension
 121   } elsif ($args->{file_type}) {
 122     $ext = $args->{file_type};
 123   } elsif ($file =~ /\.(\w+)$/) {
 124     $ext = $1;
 125   } else {
 126     $ext = defined($args->{default_ext}) ? $args->{default_ext}
 127          : defined($DEFAULT_EXT)         ? $DEFAULT_EXT
 128          : '';
 129     $file = length($ext) ? "$file.$ext" : $file;
 130   }
 131
 132   ### determine the handler
 133   my $handler = $EXT_READERS{$ext} || croak "Unknown file extension: $ext";
 134
 135   ### don't die if the file is not found - do die otherwise
 136   if (! -e $file) {
 137       eval { die "Conf file $file not found\n" };
 138       warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'} && ! $NO_WARN_ON_FAIL;
 139       return;
 140   }
 141
 142   return eval { scalar $handler->($file, $args) } || die "Error while reading conf file $file\n$@";
 143 }
 144
 145 sub read_ref {
 146   my $self = shift;
 147   my $file = shift;
 148   my $args = shift || {};
 149   return conf_read($file, {%$self, %$args});
 150 }
 151
 152 ### allow for different kinds of merging of arguments
 153 ### allow for key fallback on hashes
 154 ### allow for immutable values on hashes
 155 sub read {
 156   my $self      = shift;
 157   my $namespace = shift;
 158   my $args      = shift || {};
 159   my $REF       = $args->{ref} || undef;    # can pass in existing set of options
 160   my $IMMUTABLE = $args->{immutable} || {}; # can pass existing immutable types
 161
 162   $self = $self->new() if ! ref $self;
 163
 164   ### allow for fast short ciruit on path lookup for several cases
 165   my $directive;
 166   my @paths = ();
 167   if (ref($namespace)                   # already a ref
 168       || index($namespace,"\n") != -1   # yaml string to read in
 169       || $namespace =~ m|^\.{0,2}/.+$|  # absolute or relative file
 170       ) {
 171     push @paths, $namespace;
 172     $directive = 'FIRST';
 173
 174   ### use the default directories
 175   } else {
 176     $directive = uc($args->{directive} || $self->{directive} || $DIRECTIVE);
 177     $namespace =~ s|::|/|g;  # allow perlish style namespace
 178     my $paths = $args->{paths} || $self->paths
 179       || croak "No paths found during read on $namespace";
 180     $paths = [$paths] if ! ref $paths;
 181     if ($directive eq 'LAST') { # LAST shall be FIRST
 182       $directive = 'FIRST';
 183       $paths = [reverse @$paths] if $#$paths != 0;
 184     }
 185     foreach my $path (@$paths) {
 186       next if exists $CACHE{$path} && ! $CACHE{$path};
 187       push @paths, "$path/$namespace";
 188     }
 189   }
 190
 191   ### make sure we have at least one path
 192   if ($#paths == -1) {
 193     croak "Couldn't find a path for namespace $namespace.  Perhaps you need to pass paths => \@paths";
 194   }
 195
 196   ### now loop looking for a ref
 197   foreach my $path (@paths) {
 198     my $ref = $self->read_ref($path, $args) || next;
 199     if (! $REF) {
 200       if (UNIVERSAL::isa($ref, 'ARRAY')) {
 201         $REF = [];
 202       } elsif (UNIVERSAL::isa($ref, 'HASH')) {
 203         $REF = {};
 204       } else {
 205         croak "Unknown config type of \"".ref($ref)."\" for namespace $namespace";
 206       }
 207     } elsif (! UNIVERSAL::isa($ref, ref($REF))) {
 208       croak "Found different reference types for namespace $namespace"
 209         . " - wanted a type ".ref($REF);
 210     }
 211     if (ref($REF) eq 'ARRAY') {
 212       if ($directive eq 'MERGE') {
 213         push @$REF, @$ref;
 214         next;
 215       }
 216       splice @$REF, 0, $#$REF + 1, @$ref;
 217       last;
 218     } else {
 219       my $immutable = delete $ref->{$IMMUTABLE_KEY};
 220       my ($key,$val);
 221       if ($directive eq 'MERGE') {
 222         while (($key,$val) = each %$ref) {
 223           next if $IMMUTABLE->{$key};
 224           my $immute = $key =~ s/$IMMUTABLE_QR//o;
 225           $IMMUTABLE->{$key} = 1 if $immute || $immutable;
 226           $REF->{$key} = $val;
 227         }
 228         next;
 229       }
 230       delete $REF->{$key} while $key = each %$REF;
 231       while (($key,$val) = each %$ref) {
 232         my $immute = $key =~ s/$IMMUTABLE_QR//o;
 233         $IMMUTABLE->{$key} = 1 if $immute || $immutable;
 234         $REF->{$key} = $val;
 235       }
 236       last;
 237     }
 238   }
 239   $REF->{"Immutable Keys"} = $IMMUTABLE if scalar keys %$IMMUTABLE;
 240   return $REF;
 241 }
 242
 243 ###----------------------------------------------------------------###
 244
 245 sub read_handler_ini {
 246   my $file = shift;
 247   require Config::IniHash;
 248   return Config::IniHash::ReadINI($file);
 249 }
 250
 251 sub read_handler_pl {
 252   my $file = shift;
 253   ### do has odd behavior in that it turns a simple hashref
 254   ### into hash - help it out a little bit
 255   my @ref = do $file;
 256   return ($#ref != 0) ? {@ref} : $ref[0];
 257 }
 258
 259 sub read_handler_json {
 260   my $file = shift;
 261   local *IN;
 262   open (IN, $file) || die "Couldn't open $file: $!";
 263   CORE::read(IN, my $text, -s $file);
 264   close IN;
 265   require JSON;
 266   my $decode = JSON->VERSION > 1.98 ? 'decode' : 'jsonToObj';
 267   return scalar JSON->new->$decode($text);
 268 }
 269
 270 sub read_handler_storable {
 271   my $file = shift;
 272   require Storable;
 273   return Storable::retrieve($file);
 274 }
 275
 276 sub read_handler_yaml {
 277   my $file = shift;
 278   local *IN;
 279   open (IN, $file) || die "Couldn't open $file: $!";
 280   CORE::read(IN, my $text, -s $file);
 281   close IN;
 282   return yaml_load($text);
 283 }
 284
 285 sub yaml_load {
 286   my $text = shift;
 287   require YAML;
 288   my @ret = eval { YAML::Load($text) };
 289   if ($@) {
 290     die "$@";
 291   }
 292   return ($#ret == 0) ? $ret[0] : \@ret;
 293 }
 294
 295 sub read_handler_xml {
 296   my $file = shift;
 297   require XML::Simple;
 298   return XML::Simple::XMLin($file);
 299 }
 300
 301 ### this handler will only function if a html_key (such as validation)
 302 ### is specified - actually this somewhat specific to validation - but
 303 ### I left it as a general use for other types
 304
 305 ### is specified
 306 sub read_handler_html {
 307   my $file = shift;
 308   my $args = shift;
 309   if (! eval { require YAML }) {
 310     my $err   = $@;
 311     my $found = 0;
 312     my $i     = 0;
 313     while (my($pkg, $file, $line, $sub) = caller($i++)) {
 314       return undef if $sub =~ /\bpreload_files$/;
 315     }
 316     die $err;
 317   }
 318
 319   ### get the html
 320   local *IN;
 321   open (IN, $file) || return undef;
 322   CORE::read(IN, my $html, -s $file);
 323   close IN;
 324
 325   return html_parse_yaml_load($html, $args);
 326 }
 327
 328 sub html_parse_yaml_load {
 329   my $html = shift;
 330   my $args = shift || {};
 331   my $key  = $args->{html_key} || $HTML_KEY;
 332   return undef if ! $key || $key !~ /^\w+$/;
 333
 334   my $str = '';
 335   my @order = ();
 336   while ($html =~ m{
 337     (document\.    # global javascript
 338      | var\s+      # local javascript
 339      | <\w+\s+[^>]*?) # input, form, select, textarea tag
 340       \Q$key\E   # the key
 341       \s*=\s*    # an equals sign
 342       ([\"\'])   # open quote
 343       (.+?[^\\]) # something in between
 344       \2        # close quote
 345     }xsg) {
 346     my ($line, $quot, $yaml) = ($1, $2, $3);
 347     if ($line =~ /^(document\.|var\s)/) { # js variable
 348       $yaml =~ s/\\$quot/$quot/g;
 349       $yaml =~ s/\\n\\\n?/\n/g;
 350       $yaml =~ s/\\\\/\\/g;
 351       $yaml =~ s/\s*$/\n/s; # fix trailing newline
 352       $str = $yaml; # use last one found
 353     } else { # inline attributes
 354       $yaml =~ s/\s*$/\n/s; # fix trailing newline
 355       if ($line =~ m/<form/i) {
 356         $yaml =~ s/^\Q$1\E//m if $yaml =~ m/^( +)/s;
 357         $str .= $yaml;
 358
 359       } elsif ($line =~ m/\bname\s*=\s*('[^\']*'|"[^\"]*"|\S+)/) {
 360         my $key = $1;
 361         push @order, $key;
 362         $yaml =~ s/^/ /mg; # indent entire thing
 363         $yaml =~ s/^(\ *[^\s&*\{\[])/\n$1/; # add first newline
 364         $str .= "$key:$yaml";
 365       }
 366     }
 367   }
 368   $str .= "group order: [".join(", ",@order)."]\n"
 369     if $str && $#order != -1 && $key eq 'validation';
 370
 371   return undef if ! $str;
 372   my $ref = eval { yaml_load($str) };
 373   if ($@) {
 374     my $err = "$@";
 375     if ($err =~ /line:\s+(\d+)/) {
 376       my $line = $1;
 377       while ($str =~ m/(.+)/gm) {
 378         next if -- $line;
 379         $err .= "LINE = \"$1\"\n";
 380         last;
 381       }
 382     }
 383     die $err;
 384   }
 385   return $ref;
 386 }
 387
 388 ###----------------------------------------------------------------###
 389
 390 sub conf_write {
 391   my $file = shift;
 392   my $conf = shift || croak "Missing conf";
 393   my $args = shift || {};
 394   my $ext;
 395
 396   if (ref $file) {
 397     croak "Invalid filename for write: $file";
 398
 399   } elsif (index($file,"\n") != -1) {
 400     croak "Cannot use a yaml string as a filename during write";
 401
 402   ### allow for a pre-cached reference
 403   } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
 404     warn "Cannot write back to a file that is in the cache";
 405     return 0;
 406
 407   ### otherwise base it off of the file extension
 408   } elsif ($args->{file_type}) {
 409     $ext = $args->{file_type};
 410   } elsif ($file =~ /\.(\w+)$/) {
 411     $ext = $1;
 412   } else {
 413     $ext = defined($args->{default_ext}) ? $args->{default_ext}
 414          : defined($DEFAULT_EXT)         ? $DEFAULT_EXT
 415          : '';
 416     $file = length($ext) ? "$file.$ext" : $file;
 417   }
 418
 419   ### determine the handler
 420   my $handler;
 421   if ($args->{handler}) {
 422     $handler = (UNIVERSAL::isa($args->{handler},'CODE'))
 423       ? $args->{handler} : $args->{handler}->{$ext};
 424   }
 425   if (! $handler) {
 426     $handler = $EXT_WRITERS{$ext} || croak "Unknown file extension: $ext";
 427   }
 428
 429   return eval { scalar $handler->($file, $conf, $args) } || die "Error while writing conf file $file\n$@";
 430 }
 431
 432 sub write_ref {
 433   my $self = shift;
 434   my $file = shift;
 435   my $conf = shift;
 436   my $args = shift || {};
 437   conf_write($file, $conf, {%$self, %$args});
 438 }
 439
 440 ### Allow for writing out conf values
 441 ### Allow for writing out the correct filename (if there is a path array)
 442 ### Allow for not writing out immutable values on hashes
 443 sub write {
 444   my $self      = shift;
 445   my $namespace = shift;
 446   my $conf      = shift || croak "Must pass hashref to write out"; # the info to write
 447   my $args      = shift || {};
 448   my $IMMUTABLE = $args->{immutable} || {}; # can pass existing immutable types
 449
 450   $self = $self->new() if ! ref $self;
 451
 452   ### allow for fast short ciruit on path lookup for several cases
 453   my $directive;
 454   my @paths = ();
 455   if (ref($namespace)                   # already a ref
 456       || $namespace =~ m|^\.{0,2}/.+$|  # absolute or relative file
 457       ) {
 458     push @paths, $namespace;
 459     $directive = 'FIRST';
 460
 461   } elsif (index($namespace,"\n") != -1) { # yaml string - can't write that
 462     croak "Cannot use a yaml string as a namespace for write";
 463
 464   ### use the default directories
 465   } else {
 466     $directive = uc($args->{directive} || $self->{directive} || $DIRECTIVE);
 467     $namespace =~ s|::|/|g;  # allow perlish style namespace
 468     my $paths = $args->{paths} || $self->paths
 469       || croak "No paths found during write on $namespace";
 470     $paths = [$paths] if ! ref $paths;
 471     if ($directive eq 'LAST') { # LAST shall be FIRST
 472       $directive = 'FIRST';
 473       $paths = [reverse @$paths] if $#$paths != 0;
 474     }
 475     foreach my $path (@$paths) {
 476       next if exists $CACHE{$path} && ! $CACHE{$path};
 477       push @paths, "$path/$namespace";
 478     }
 479   }
 480
 481   ### make sure we have at least one path
 482   if ($#paths == -1) {
 483     croak "Couldn't find a path for namespace $namespace.  Perhaps you need to pass paths => \@paths";
 484   }
 485
 486   my $path;
 487   if ($directive eq 'FIRST') {
 488     $path = $paths[0];
 489   } elsif ($directive eq 'LAST' || $directive eq 'MERGE') {
 490     $path = $paths[-1];
 491   } else {
 492     croak "Unknown directive ($directive) during write of $namespace";
 493   }
 494
 495   ### remove immutable items (if any)
 496   if (UNIVERSAL::isa($conf, 'HASH') && $conf->{"Immutable Keys"}) {
 497     $conf = {%$conf}; # copy the values - only for immutable
 498     my $IMMUTABLE = delete $conf->{"Immutable Keys"};
 499     foreach my $key (keys %$IMMUTABLE) {
 500       delete $conf->{$key};
 501     }
 502   }
 503
 504   ### finally write it out
 505   $self->write_ref($path, $conf);
 506
 507   return 1;
 508 }
 509
 510 ###----------------------------------------------------------------###
 511
 512 sub write_handler_ini {
 513   my $file = shift;
 514   my $ref  = shift;
 515   require Config::IniHash;
 516   return Config::IniHash::WriteINI($file, $ref);
 517 }
 518
 519 sub write_handler_pl {
 520   my $file = shift;
 521   my $ref  = shift;
 522   ### do has odd behavior in that it turns a simple hashref
 523   ### into hash - help it out a little bit
 524   require Data::Dumper;
 525   local $Data::Dump::Purity = 1;
 526   local $Data::Dumper::Sortkeys  = 1;
 527   local $Data::Dumper::Quotekeys = 0;
 528   local $Data::Dumper::Pad       = '  ';
 529   local $Data::Dumper::Varname   = 'VunderVar';
 530   my $str = Data::Dumper->Dumpperl([$ref]);
 531   if ($str =~ s/^(.+?=\s*)//s) {
 532     my $l = length($1);
 533     $str =~ s/^\s{1,$l}//mg;
 534   }
 535   if ($str =~ /\$VunderVar/) {
 536     die "Ref to be written contained circular references - can't write";
 537   }
 538
 539   local *OUT;
 540   open (OUT, ">$file") || die $!;
 541   print OUT $str;
 542   close OUT;
 543 }
 544
 545 sub write_handler_json {
 546   my $file = shift;
 547   my $ref  = shift;
 548   require JSON;
 549   my $str;
 550   if (JSON->VERSION > 1.98) {
 551       my $j = JSON->new;
 552       $j->canonical(1);
 553       $j->pretty;
 554       $str = $j->encode($ref);
 555   } else {
 556       $str = JSON->new->objToJSon($ref, {pretty => 1, indent => 2});
 557   }
 558   local *OUT;
 559   open (OUT, ">$file") || die $!;
 560   print OUT $str;
 561   close(OUT);
 562 }
 563
 564 sub write_handler_storable {
 565   my $file = shift;
 566   my $ref  = shift;
 567   require Storable;
 568   return Storable::store($ref, $file);
 569 }
 570
 571 sub write_handler_yaml {
 572   my $file = shift;
 573   my $ref  = shift;
 574   require YAML;
 575   return YAML::DumpFile($file, $ref);
 576 }
 577
 578 sub write_handler_xml {
 579   my $file = shift;
 580   my $ref  = shift;
 581   require XML::Simple;
 582   local *OUT;
 583   open (OUT, ">$file") || die $!;
 584   print OUT scalar(XML::Simple->new->XMLout($ref, noattr => 1));
 585   close(OUT);
 586 }
 587
 588 sub write_handler_html {
 589   my $file = shift;
 590   my $ref  = shift;
 591   die "Write of conf information to html is not supported";
 592 }
 593
 594 ###----------------------------------------------------------------###
 595
 596 sub preload_files {
 597     my $self  = shift;
 598     my $paths = shift || $self->paths;
 599
 600     ### what extensions do we look for
 601     my %EXT;
 602     if ($self->{'handler'}) {
 603         if (UNIVERSAL::isa($self->{'handler'},'HASH')) {
 604             %EXT = %{ $self->{'handler'} };
 605         }
 606     } else {
 607         %EXT = %EXT_READERS;
 608         if (! $self->{'html_key'} && ! $HTML_KEY) {
 609             delete $EXT{$_} foreach qw(html htm);
 610         }
 611     }
 612     return if ! keys %EXT;
 613
 614     ### look in the paths for the files
 615     foreach my $path (ref($paths) ? @$paths : $paths) {
 616         $path =~ s|//+|/|g;
 617         $path =~ s|/$||;
 618         next if exists $CACHE{$path};
 619         if (-f $path) {
 620             my $ext = ($path =~ /\.(\w+)$/) ? $1 : '';
 621             next if ! $EXT{$ext};
 622             $CACHE{$path} = $self->read($path);
 623         } elsif (-d _) {
 624             $CACHE{$path} = 1;
 625             require File::Find;
 626             File::Find::find(sub {
 627                 return if exists $CACHE{$File::Find::name};
 628                 return if $File::Find::name =~ m|/CVS/|;
 629                 return if ! -f;
 630                 my $ext = (/\.(\w+)$/) ? $1 : '';
 631                 return if ! $EXT{$ext};
 632                 $CACHE{$File::Find::name} = $self->read($File::Find::name);
 633             }, "$path/");
 634         } else {
 635             $CACHE{$path} = 0;
 636         }
 637     }
 638 }
 639
 640 sub in_cache {
 641     my ($self, $file) = (@_ == 2) ? @_ : (undef, shift());
 642     return exists($CACHE{$file}) || 0;
 643 }
 644
 645 ###----------------------------------------------------------------###
 646
 647 1;
 648
 649 __END__
 650
 651 =head1 SYNOPSIS
 652
 653     use CGI::Ex::Conf qw(conf_read conf_write);
 654
 655     my $hash = conf_read("/tmp/foo.yaml");
 656
 657     conf_write("/tmp/foo.yaml", {key1 => $val1, key2 => $val2});
 658
 659
 660     ### OOP interface
 661
 662     my $cob = CGI::Ex::Conf->new;
 663
 664     my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml
 665     my $hash = $cob->read($file);
 666
 667     local $cob->{default_ext} = 'conf'; # default anyway
 668
 669
 670     my @paths = qw(/tmp, /home/pauls);
 671     local $cob->{paths} = \@paths;
 672     my $hash = $cob->read('My::NameSpace');
 673     # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf
 674
 675
 676     my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']});
 677     # will look in /tmp/My/NameSpace.conf
 678
 679
 680     local $cob->{directive} = 'MERGE';
 681     my $hash = $cob->read('FooSpace');
 682     # OR #
 683     my $hash = $cob->read('FooSpace', {directive => 'MERGE'});
 684     # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf
 685     # immutable keys are preserved from originating files
 686
 687
 688     local $cob->{directive} = 'FIRST';
 689     my $hash = $cob->read('FooSpace');
 690     # will return values from first found file in the path.
 691
 692
 693     local $cob->{directive} = 'LAST'; # default behavior
 694     my $hash = $cob->read('FooSpace');
 695     # will return values from last found file in the path.
 696
 697
 698     ### manipulate $hash
 699     $cob->write('FooSpace'); # will write it out the changes
 700
 701 =head1 DESCRIPTION
 702
 703 There are half a million Conf readers out there.  Why not add one more.
 704 Actually, this module provides a wrapper around the many file formats
 705 and the config modules that can handle them.  It does not introduce any
 706 formats of its own.
 707
 708 This module also provides a preload ability which is useful in conjunction
 709 with mod_perl.
 710
 711 Oh - and it writes too.
 712
 713 =head1 METHODS
 714
 715 =over 4
 716
 717 =item C<read_ref>
 718
 719 Takes a file and optional argument hashref.  Figures out the type
 720 of handler to use to read the file, reads it and returns the ref.
 721 If you don't need the extended merge functionality, or key fallback,
 722 or immutable keys, or path lookup ability - then use this method.
 723 Otherwise - use ->read.
 724
 725 =item C<read>
 726
 727 First argument may be either a perl data structure, yaml string, a
 728 full filename, or a file "namespace".
 729
 730 The second argument can be a hashref of override values (referred to
 731 as $args below)..
 732
 733 If the first argument is a perl data structure, it will be
 734 copied one level deep and returned (nested structures will contain the
 735 same references).  A yaml string will be parsed and returned.  A full
 736 filename will be read using the appropriate handler and returned (a
 737 file beginning with a / or ./ or ../ is considered to be a full
 738 filename).  A file "namespace" (ie "footer" or "my::config" or
 739 "what/ever") will be turned into a filename by looking for that
 740 namespace in the paths found either in $args->{paths} or in
 741 $self->{paths} or in @DEFAULT_PATHS.  @DEFAULT_PATHS is empty by
 742 default as is $self->{paths} - read makes no attempt to guess what
 743 directories to look in.  If the namespace has no extension the
 744 extension listed in $args->{default_ext} or $self->{default_ext} or
 745 $DEFAULT_EXT will be used).
 746
 747   my $ref = $cob->read('My::NameSpace', {
 748     paths => [qw(/tmp /usr/data)],
 749     default_ext => 'pl',
 750   });
 751   # would look first for /tmp/My/NameSpace.pl
 752   # and then /usr/data/My/NameSpace.pl
 753
 754   my $ref = $cob->read('foo.sto', {
 755     paths => [qw(/tmp /usr/data)],
 756     default_ext => 'pl',
 757   });
 758   # would look first for /tmp/foo.sto
 759   # and then /usr/data/foo.sto
 760
 761 When a namespace is used and there are multiple possible paths, there
 762 area a few options to control which file to look for.  A directive of
 763 'FIRST', 'MERGE', or 'LAST' may be specified in $args->{directive} or
 764 $self->{directive} or the default value in $DIRECTIVE will be used
 765 (default is 'LAST'). When 'FIRST' is specified the first path that
 766 contains the namespace is returned.  If 'LAST' is used, the last
 767 found path that contains the namespace is returned.  If 'MERGE' is
 768 used, the data structures are joined together.  If they are
 769 arrayrefs, they are joined into one large arrayref.  If they are
 770 hashes, they are layered on top of each other with keys found in later
 771 paths overwriting those found in earlier paths.  This allows for
 772 setting system defaults in a root file, and then allow users to have
 773 custom overrides.
 774
 775 It is possible to make keys in a root file be immutable (non
 776 overwritable) by adding a suffix of _immutable or _immu to the key (ie
 777 {foo_immutable => 'bar'}).  If a value is found in the file that
 778 matches $IMMUTABLE_KEY, the entire file is considered immutable.
 779 The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY.
 780
 781 Errors during read die.  If the file does not exist undef is returned.
 782
 783 =item C<write_ref>
 784
 785 Takes a file and the reference to be written.  Figures out the type
 786 of handler to use to write the file and writes it. If you used the ->read_ref
 787 use this method.  Otherwise, use ->write.
 788
 789 =item C<write>
 790
 791 Allows for writing back out the information read in by ->read.  If multiple
 792 paths where used - the directive 'FIRST' will write the changes to the first
 793 file in the path - otherwise the last path will be used.  If ->read had found
 794 immutable keys, then those keys are removed before writing.
 795
 796 Errors during write die.
 797
 798 =item C<preload_files>
 799
 800 Arguments are file(s) and/or directory(s) to preload.  preload_files will
 801 loop through the arguments, find the files that exist, read them in using
 802 the handler which matches the files extension, and cache them by filename
 803 in %CACHE.  Directories are spidered for file extensions which match those
 804 listed in %EXT_READERS.  This is useful for a server environment where CPU
 805 may be more precious than memory.
 806
 807 =item C<in_cache>
 808
 809 Allow for testing if a particular filename is registered in the %CACHE - typically
 810 from a preload_files call.  This is useful when building wrappers around the
 811 conf_read and conf_write method calls.
 812
 813 =back
 814
 815 =head1 FUNCTIONS
 816
 817 =over 4
 818
 819 =item conf_read
 820
 821 Takes a filename.  Returns the read contents of that filename.  The handler
 822 to use is based upon the extention on the file.
 823
 824     my $hash = conf_read('/tmp/foo.yaml');
 825
 826     my $hash = conf_read('/tmp/foo', {file_type => 'yaml'});
 827
 828 Takes a filename and a data structure.  Writes the data to the filename.  The handler
 829 to use is based upon the extention on the file.
 830
 831     conf_write('/tmp/foo.yaml', \%hash);
 832
 833     conf_write('/tmp/foo', \%hash, {file_type => 'yaml'});
 834
 835 =back
 836
 837 =head1 FILETYPES
 838
 839 CGI::Ex::Conf supports the files found in %EXT_READERS by default.
 840 Additional types may be added to %EXT_READERS, or a custom handler may be
 841 passed via $args->{handler} or $self->{handler}.  If the custom handler is
 842 a code ref, all files will be passed to it.  If it is a hashref, it should
 843 contain keys which are extensions it supports, and values which read those
 844 extensions.
 845
 846 Some file types have benefits over others.  Storable is very fast, but is
 847 binary and not human readable.  YAML is readable but very slow.  I would
 848 suggest using a readable format such as YAML and then using preload_files
 849 to load in what you need at run time.  All preloaded files are faster than
 850 any of the other types.
 851
 852 The following is the list of handlers that ships with CGI::Ex::Conf (they
 853 will only work if the supporting module is installed on your system):
 854
 855 =over 4
 856
 857 =item C<pl>
 858
 859 Should be a file containing a perl structure which is the last thing returned.
 860
 861 =item C<sto> and C<storable>
 862
 863 Should be a file containing a structure stored in Storable format.
 864 See L<Storable>.
 865
 866 =item C<yaml> and C<conf> and C<val>
 867
 868 Should be a file containing a yaml document.  Multiple documents are returned
 869 as a single arrayref.  Also - any file without an extension and custom handler
 870 will be read using YAML.  See L<YAML>.
 871
 872 =item C<ini>
 873
 874 Should be a windows style ini file.  See L<Config::IniHash>
 875
 876 =item C<xml>
 877
 878 Should be an xml file.  It will be read in by XMLin.  See L<XML::Simple>.
 879
 880 =item C<json>
 881
 882 Should be a json file.  It will be read using the JSON library.  See L<JSON>.
 883
 884 =item C<html> and C<htm>
 885
 886 This is actually a custom type intended for use with CGI::Ex::Validate.
 887 The configuration to be read is actually validation that is stored
 888 inline with the html.  The handler will look for any form elements or
 889 input elements with an attribute with the same name as in $HTML_KEY.  It
 890 will also look for a javascript variable by the same name as in $HTML_KEY.
 891 All configuration items done this way should be written in YAML.
 892 For example, if $HTML_KEY contained 'validation' it would find validation in:
 893
 894   <input type=text name=username validation="{required: 1}">
 895   # automatically indented and "username:\n" prepended
 896   # AND #
 897   <form name=foo validation="
 898   general no_confirm: 1
 899   ">
 900   # AND #
 901   <script>
 902   document.validation = "\n\
 903   username: {required: 1}\n\
 904   ";
 905   </script>
 906   # AND #
 907   <script>
 908   var validation = "\n\
 909   username: {required: 1}\n\
 910   ";
 911   </script>
 912
 913 If the key $HTML_KEY is not set, the handler will always return undef
 914 without even opening the file.
 915
 916 =back
 917
 918 =head1 TODO
 919
 920 Make a similar write method that handles immutability.
 921
 922 =head1 LICENSE
 923
 924 This module may be distributed under the same terms as Perl itself.
 925
 926 =head1 AUTHOR
 927
 928 Paul Seamons <perl at seamons dot com>
 929
 930 =cut
 931