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.24';
  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   return scalar JSON::jsonToObj($text);
 267 }
 268
 269 sub read_handler_storable {
 270   my $file = shift;
 271   require Storable;
 272   return Storable::retrieve($file);
 273 }
 274
 275 sub read_handler_yaml {
 276   my $file = shift;
 277   local *IN;
 278   open (IN, $file) || die "Couldn't open $file: $!";
 279   CORE::read(IN, my $text, -s $file);
 280   close IN;
 281   return yaml_load($text);
 282 }
 283
 284 sub yaml_load {
 285   my $text = shift;
 286   require YAML;
 287   my @ret = eval { YAML::Load($text) };
 288   if ($@) {
 289     die "$@";
 290   }
 291   return ($#ret == 0) ? $ret[0] : \@ret;
 292 }
 293
 294 sub read_handler_xml {
 295   my $file = shift;
 296   require XML::Simple;
 297   return XML::Simple::XMLin($file);
 298 }
 299
 300 ### this handler will only function if a html_key (such as validation)
 301 ### is specified - actually this somewhat specific to validation - but
 302 ### I left it as a general use for other types
 303
 304 ### is specified
 305 sub read_handler_html {
 306   my $file = shift;
 307   my $args = shift;
 308   if (! eval { require YAML }) {
 309     my $err   = $@;
 310     my $found = 0;
 311     my $i     = 0;
 312     while (my($pkg, $file, $line, $sub) = caller($i++)) {
 313       return undef if $sub =~ /\bpreload_files$/;
 314     }
 315     die $err;
 316   }
 317
 318   ### get the html
 319   local *IN;
 320   open (IN, $file) || return undef;
 321   CORE::read(IN, my $html, -s $file);
 322   close IN;
 323
 324   return html_parse_yaml_load($html, $args);
 325 }
 326
 327 sub html_parse_yaml_load {
 328   my $html = shift;
 329   my $args = shift || {};
 330   my $key  = $args->{html_key} || $HTML_KEY;
 331   return undef if ! $key || $key !~ /^\w+$/;
 332
 333   my $str = '';
 334   my @order = ();
 335   while ($html =~ m{
 336     (document\.    # global javascript
 337      | var\s+      # local javascript
 338      | <\w+\s+[^>]*?) # input, form, select, textarea tag
 339       \Q$key\E   # the key
 340       \s*=\s*    # an equals sign
 341       ([\"\'])   # open quote
 342       (.+?[^\\]) # something in between
 343       \2        # close quote
 344     }xsg) {
 345     my ($line, $quot, $yaml) = ($1, $2, $3);
 346     if ($line =~ /^(document\.|var\s)/) { # js variable
 347       $yaml =~ s/\\$quot/$quot/g;
 348       $yaml =~ s/\\n\\\n?/\n/g;
 349       $yaml =~ s/\\\\/\\/g;
 350       $yaml =~ s/\s*$/\n/s; # fix trailing newline
 351       $str = $yaml; # use last one found
 352     } else { # inline attributes
 353       $yaml =~ s/\s*$/\n/s; # fix trailing newline
 354       if ($line =~ m/<form/i) {
 355         $yaml =~ s/^\Q$1\E//m if $yaml =~ m/^( +)/s;
 356         $str .= $yaml;
 357
 358       } elsif ($line =~ m/\bname\s*=\s*('[^\']*'|"[^\"]*"|\S+)/) {
 359         my $key = $1;
 360         push @order, $key;
 361         $yaml =~ s/^/ /mg; # indent entire thing
 362         $yaml =~ s/^(\ *[^\s&*\{\[])/\n$1/; # add first newline
 363         $str .= "$key:$yaml";
 364       }
 365     }
 366   }
 367   $str .= "group order: [".join(", ",@order)."]\n"
 368     if $str && $#order != -1 && $key eq 'validation';
 369
 370   return undef if ! $str;
 371   my $ref = eval { yaml_load($str) };
 372   if ($@) {
 373     my $err = "$@";
 374     if ($err =~ /line:\s+(\d+)/) {
 375       my $line = $1;
 376       while ($str =~ m/(.+)/gm) {
 377         next if -- $line;
 378         $err .= "LINE = \"$1\"\n";
 379         last;
 380       }
 381     }
 382     die $err;
 383   }
 384   return $ref;
 385 }
 386
 387 ###----------------------------------------------------------------###
 388
 389 sub conf_write {
 390   my $file = shift;
 391   my $conf = shift || croak "Missing conf";
 392   my $args = shift || {};
 393   my $ext;
 394
 395   if (ref $file) {
 396     croak "Invalid filename for write: $file";
 397
 398   } elsif (index($file,"\n") != -1) {
 399     croak "Cannot use a yaml string as a filename during write";
 400
 401   ### allow for a pre-cached reference
 402   } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
 403     warn "Cannot write back to a file that is in the cache";
 404     return 0;
 405
 406   ### otherwise base it off of the file extension
 407   } elsif ($args->{file_type}) {
 408     $ext = $args->{file_type};
 409   } elsif ($file =~ /\.(\w+)$/) {
 410     $ext = $1;
 411   } else {
 412     $ext = defined($args->{default_ext}) ? $args->{default_ext}
 413          : defined($DEFAULT_EXT)         ? $DEFAULT_EXT
 414          : '';
 415     $file = length($ext) ? "$file.$ext" : $file;
 416   }
 417
 418   ### determine the handler
 419   my $handler;
 420   if ($args->{handler}) {
 421     $handler = (UNIVERSAL::isa($args->{handler},'CODE'))
 422       ? $args->{handler} : $args->{handler}->{$ext};
 423   }
 424   if (! $handler) {
 425     $handler = $EXT_WRITERS{$ext} || croak "Unknown file extension: $ext";
 426   }
 427
 428   return eval { scalar $handler->($file, $conf, $args) } || die "Error while writing conf file $file\n$@";
 429 }
 430
 431 sub write_ref {
 432   my $self = shift;
 433   my $file = shift;
 434   my $conf = shift;
 435   my $args = shift || {};
 436   conf_write($file, $conf, {%$self, %$args});
 437 }
 438
 439 ### Allow for writing out conf values
 440 ### Allow for writing out the correct filename (if there is a path array)
 441 ### Allow for not writing out immutable values on hashes
 442 sub write {
 443   my $self      = shift;
 444   my $namespace = shift;
 445   my $conf      = shift || croak "Must pass hashref to write out"; # the info to write
 446   my $args      = shift || {};
 447   my $IMMUTABLE = $args->{immutable} || {}; # can pass existing immutable types
 448
 449   $self = $self->new() if ! ref $self;
 450
 451   ### allow for fast short ciruit on path lookup for several cases
 452   my $directive;
 453   my @paths = ();
 454   if (ref($namespace)                   # already a ref
 455       || $namespace =~ m|^\.{0,2}/.+$|  # absolute or relative file
 456       ) {
 457     push @paths, $namespace;
 458     $directive = 'FIRST';
 459
 460   } elsif (index($namespace,"\n") != -1) { # yaml string - can't write that
 461     croak "Cannot use a yaml string as a namespace for write";
 462
 463   ### use the default directories
 464   } else {
 465     $directive = uc($args->{directive} || $self->{directive} || $DIRECTIVE);
 466     $namespace =~ s|::|/|g;  # allow perlish style namespace
 467     my $paths = $args->{paths} || $self->paths
 468       || croak "No paths found during write on $namespace";
 469     $paths = [$paths] if ! ref $paths;
 470     if ($directive eq 'LAST') { # LAST shall be FIRST
 471       $directive = 'FIRST';
 472       $paths = [reverse @$paths] if $#$paths != 0;
 473     }
 474     foreach my $path (@$paths) {
 475       next if exists $CACHE{$path} && ! $CACHE{$path};
 476       push @paths, "$path/$namespace";
 477     }
 478   }
 479
 480   ### make sure we have at least one path
 481   if ($#paths == -1) {
 482     croak "Couldn't find a path for namespace $namespace.  Perhaps you need to pass paths => \@paths";
 483   }
 484
 485   my $path;
 486   if ($directive eq 'FIRST') {
 487     $path = $paths[0];
 488   } elsif ($directive eq 'LAST' || $directive eq 'MERGE') {
 489     $path = $paths[-1];
 490   } else {
 491     croak "Unknown directive ($directive) during write of $namespace";
 492   }
 493
 494   ### remove immutable items (if any)
 495   if (UNIVERSAL::isa($conf, 'HASH') && $conf->{"Immutable Keys"}) {
 496     $conf = {%$conf}; # copy the values - only for immutable
 497     my $IMMUTABLE = delete $conf->{"Immutable Keys"};
 498     foreach my $key (keys %$IMMUTABLE) {
 499       delete $conf->{$key};
 500     }
 501   }
 502
 503   ### finally write it out
 504   $self->write_ref($path, $conf);
 505
 506   return 1;
 507 }
 508
 509 ###----------------------------------------------------------------###
 510
 511 sub write_handler_ini {
 512   my $file = shift;
 513   my $ref  = shift;
 514   require Config::IniHash;
 515   return Config::IniHash::WriteINI($file, $ref);
 516 }
 517
 518 sub write_handler_pl {
 519   my $file = shift;
 520   my $ref  = shift;
 521   ### do has odd behavior in that it turns a simple hashref
 522   ### into hash - help it out a little bit
 523   require Data::Dumper;
 524   local $Data::Dump::Purity = 1;
 525   local $Data::Dumper::Sortkeys  = 1;
 526   local $Data::Dumper::Quotekeys = 0;
 527   local $Data::Dumper::Pad       = '  ';
 528   local $Data::Dumper::Varname   = 'VunderVar';
 529   my $str = Data::Dumper->Dumpperl([$ref]);
 530   if ($str =~ s/^(.+?=\s*)//s) {
 531     my $l = length($1);
 532     $str =~ s/^\s{1,$l}//mg;
 533   }
 534   if ($str =~ /\$VunderVar/) {
 535     die "Ref to be written contained circular references - can't write";
 536   }
 537
 538   local *OUT;
 539   open (OUT, ">$file") || die $!;
 540   print OUT $str;
 541   close OUT;
 542 }
 543
 544 sub write_handler_json {
 545   my $file = shift;
 546   my $ref  = shift;
 547   require JSON;
 548   my $str = JSON::objToJson($ref, {pretty => 1, indent => 2});
 549   local *OUT;
 550   open (OUT, ">$file") || die $!;
 551   print OUT $str;
 552   close(OUT);
 553 }
 554
 555 sub write_handler_storable {
 556   my $file = shift;
 557   my $ref  = shift;
 558   require Storable;
 559   return Storable::store($ref, $file);
 560 }
 561
 562 sub write_handler_yaml {
 563   my $file = shift;
 564   my $ref  = shift;
 565   require YAML;
 566   return YAML::DumpFile($file, $ref);
 567 }
 568
 569 sub write_handler_xml {
 570   my $file = shift;
 571   my $ref  = shift;
 572   require XML::Simple;
 573   local *OUT;
 574   open (OUT, ">$file") || die $!;
 575   print OUT scalar(XML::Simple->new->XMLout($ref, noattr => 1));
 576   close(OUT);
 577 }
 578
 579 sub write_handler_html {
 580   my $file = shift;
 581   my $ref  = shift;
 582   die "Write of conf information to html is not supported";
 583 }
 584
 585 ###----------------------------------------------------------------###
 586
 587 sub preload_files {
 588     my $self  = shift;
 589     my $paths = shift || $self->paths;
 590
 591     ### what extensions do we look for
 592     my %EXT;
 593     if ($self->{'handler'}) {
 594         if (UNIVERSAL::isa($self->{'handler'},'HASH')) {
 595             %EXT = %{ $self->{'handler'} };
 596         }
 597     } else {
 598         %EXT = %EXT_READERS;
 599         if (! $self->{'html_key'} && ! $HTML_KEY) {
 600             delete $EXT{$_} foreach qw(html htm);
 601         }
 602     }
 603     return if ! keys %EXT;
 604
 605     ### look in the paths for the files
 606     foreach my $path (ref($paths) ? @$paths : $paths) {
 607         $path =~ s|//+|/|g;
 608         $path =~ s|/$||;
 609         next if exists $CACHE{$path};
 610         if (-f $path) {
 611             my $ext = ($path =~ /\.(\w+)$/) ? $1 : '';
 612             next if ! $EXT{$ext};
 613             $CACHE{$path} = $self->read($path);
 614         } elsif (-d _) {
 615             $CACHE{$path} = 1;
 616             require File::Find;
 617             File::Find::find(sub {
 618                 return if exists $CACHE{$File::Find::name};
 619                 return if $File::Find::name =~ m|/CVS/|;
 620                 return if ! -f;
 621                 my $ext = (/\.(\w+)$/) ? $1 : '';
 622                 return if ! $EXT{$ext};
 623                 $CACHE{$File::Find::name} = $self->read($File::Find::name);
 624             }, "$path/");
 625         } else {
 626             $CACHE{$path} = 0;
 627         }
 628     }
 629 }
 630
 631 sub in_cache {
 632     my ($self, $file) = (@_ == 2) ? @_ : (undef, shift());
 633     return exists($CACHE{$file}) || 0;
 634 }
 635
 636 ###----------------------------------------------------------------###
 637
 638 1;
 639
 640 __END__
 641
 642 =head1 SYNOPSIS
 643
 644     use CGI::Ex::Conf qw(conf_read conf_write);
 645
 646     my $hash = conf_read("/tmp/foo.yaml");
 647
 648     conf_write("/tmp/foo.yaml", {key1 => $val1, key2 => $val2});
 649
 650
 651     ### OOP interface
 652
 653     my $cob = CGI::Ex::Conf->new;
 654
 655     my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml
 656     my $hash = $cob->read($file);
 657
 658     local $cob->{default_ext} = 'conf'; # default anyway
 659
 660
 661     my @paths = qw(/tmp, /home/pauls);
 662     local $cob->{paths} = \@paths;
 663     my $hash = $cob->read('My::NameSpace');
 664     # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf
 665
 666
 667     my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']});
 668     # will look in /tmp/My/NameSpace.conf
 669
 670
 671     local $cob->{directive} = 'MERGE';
 672     my $hash = $cob->read('FooSpace');
 673     # OR #
 674     my $hash = $cob->read('FooSpace', {directive => 'MERGE'});
 675     # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf
 676     # immutable keys are preserved from originating files
 677
 678
 679     local $cob->{directive} = 'FIRST';
 680     my $hash = $cob->read('FooSpace');
 681     # will return values from first found file in the path.
 682
 683
 684     local $cob->{directive} = 'LAST'; # default behavior
 685     my $hash = $cob->read('FooSpace');
 686     # will return values from last found file in the path.
 687
 688
 689     ### manipulate $hash
 690     $cob->write('FooSpace'); # will write it out the changes
 691
 692 =head1 DESCRIPTION
 693
 694 There are half a million Conf readers out there.  Why not add one more.
 695 Actually, this module provides a wrapper around the many file formats
 696 and the config modules that can handle them.  It does not introduce any
 697 formats of its own.
 698
 699 This module also provides a preload ability which is useful in conjunction
 700 with mod_perl.
 701
 702 Oh - and it writes too.
 703
 704 =head1 METHODS
 705
 706 =over 4
 707
 708 =item C<read_ref>
 709
 710 Takes a file and optional argument hashref.  Figures out the type
 711 of handler to use to read the file, reads it and returns the ref.
 712 If you don't need the extended merge functionality, or key fallback,
 713 or immutable keys, or path lookup ability - then use this method.
 714 Otherwise - use ->read.
 715
 716 =item C<read>
 717
 718 First argument may be either a perl data structure, yaml string, a
 719 full filename, or a file "namespace".
 720
 721 The second argument can be a hashref of override values (referred to
 722 as $args below)..
 723
 724 If the first argument is a perl data structure, it will be
 725 copied one level deep and returned (nested structures will contain the
 726 same references).  A yaml string will be parsed and returned.  A full
 727 filename will be read using the appropriate handler and returned (a
 728 file beginning with a / or ./ or ../ is considered to be a full
 729 filename).  A file "namespace" (ie "footer" or "my::config" or
 730 "what/ever") will be turned into a filename by looking for that
 731 namespace in the paths found either in $args->{paths} or in
 732 $self->{paths} or in @DEFAULT_PATHS.  @DEFAULT_PATHS is empty by
 733 default as is $self->{paths} - read makes no attempt to guess what
 734 directories to look in.  If the namespace has no extension the
 735 extension listed in $args->{default_ext} or $self->{default_ext} or
 736 $DEFAULT_EXT will be used).
 737
 738   my $ref = $cob->read('My::NameSpace', {
 739     paths => [qw(/tmp /usr/data)],
 740     default_ext => 'pl',
 741   });
 742   # would look first for /tmp/My/NameSpace.pl
 743   # and then /usr/data/My/NameSpace.pl
 744
 745   my $ref = $cob->read('foo.sto', {
 746     paths => [qw(/tmp /usr/data)],
 747     default_ext => 'pl',
 748   });
 749   # would look first for /tmp/foo.sto
 750   # and then /usr/data/foo.sto
 751
 752 When a namespace is used and there are multiple possible paths, there
 753 area a few options to control which file to look for.  A directive of
 754 'FIRST', 'MERGE', or 'LAST' may be specified in $args->{directive} or
 755 $self->{directive} or the default value in $DIRECTIVE will be used
 756 (default is 'LAST'). When 'FIRST' is specified the first path that
 757 contains the namespace is returned.  If 'LAST' is used, the last
 758 found path that contains the namespace is returned.  If 'MERGE' is
 759 used, the data structures are joined together.  If they are
 760 arrayrefs, they are joined into one large arrayref.  If they are
 761 hashes, they are layered on top of each other with keys found in later
 762 paths overwriting those found in earlier paths.  This allows for
 763 setting system defaults in a root file, and then allow users to have
 764 custom overrides.
 765
 766 It is possible to make keys in a root file be immutable (non
 767 overwritable) by adding a suffix of _immutable or _immu to the key (ie
 768 {foo_immutable => 'bar'}).  If a value is found in the file that
 769 matches $IMMUTABLE_KEY, the entire file is considered immutable.
 770 The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY.
 771
 772 Errors during read die.  If the file does not exist undef is returned.
 773
 774 =item C<write_ref>
 775
 776 Takes a file and the reference to be written.  Figures out the type
 777 of handler to use to write the file and writes it. If you used the ->read_ref
 778 use this method.  Otherwise, use ->write.
 779
 780 =item C<write>
 781
 782 Allows for writing back out the information read in by ->read.  If multiple
 783 paths where used - the directive 'FIRST' will write the changes to the first
 784 file in the path - otherwise the last path will be used.  If ->read had found
 785 immutable keys, then those keys are removed before writing.
 786
 787 Errors during write die.
 788
 789 =item C<preload_files>
 790
 791 Arguments are file(s) and/or directory(s) to preload.  preload_files will
 792 loop through the arguments, find the files that exist, read them in using
 793 the handler which matches the files extension, and cache them by filename
 794 in %CACHE.  Directories are spidered for file extensions which match those
 795 listed in %EXT_READERS.  This is useful for a server environment where CPU
 796 may be more precious than memory.
 797
 798 =item C<in_cache>
 799
 800 Allow for testing if a particular filename is registered in the %CACHE - typically
 801 from a preload_files call.  This is useful when building wrappers around the
 802 conf_read and conf_write method calls.
 803
 804 =back
 805
 806 =head1 FUNCTIONS
 807
 808 =over 4
 809
 810 =item conf_read
 811
 812 Takes a filename.  Returns the read contents of that filename.  The handler
 813 to use is based upon the extention on the file.
 814
 815     my $hash = conf_read('/tmp/foo.yaml');
 816
 817     my $hash = conf_read('/tmp/foo', {file_type => 'yaml'});
 818
 819 Takes a filename and a data structure.  Writes the data to the filename.  The handler
 820 to use is based upon the extention on the file.
 821
 822     conf_write('/tmp/foo.yaml', \%hash);
 823
 824     conf_write('/tmp/foo', \%hash, {file_type => 'yaml'});
 825
 826 =back
 827
 828 =head1 FILETYPES
 829
 830 CGI::Ex::Conf supports the files found in %EXT_READERS by default.
 831 Additional types may be added to %EXT_READERS, or a custom handler may be
 832 passed via $args->{handler} or $self->{handler}.  If the custom handler is
 833 a code ref, all files will be passed to it.  If it is a hashref, it should
 834 contain keys which are extensions it supports, and values which read those
 835 extensions.
 836
 837 Some file types have benefits over others.  Storable is very fast, but is
 838 binary and not human readable.  YAML is readable but very slow.  I would
 839 suggest using a readable format such as YAML and then using preload_files
 840 to load in what you need at run time.  All preloaded files are faster than
 841 any of the other types.
 842
 843 The following is the list of handlers that ships with CGI::Ex::Conf (they
 844 will only work if the supporting module is installed on your system):
 845
 846 =over 4
 847
 848 =item C<pl>
 849
 850 Should be a file containing a perl structure which is the last thing returned.
 851
 852 =item C<sto> and C<storable>
 853
 854 Should be a file containing a structure stored in Storable format.
 855 See L<Storable>.
 856
 857 =item C<yaml> and C<conf> and C<val>
 858
 859 Should be a file containing a yaml document.  Multiple documents are returned
 860 as a single arrayref.  Also - any file without an extension and custom handler
 861 will be read using YAML.  See L<YAML>.
 862
 863 =item C<ini>
 864
 865 Should be a windows style ini file.  See L<Config::IniHash>
 866
 867 =item C<xml>
 868
 869 Should be an xml file.  It will be read in by XMLin.  See L<XML::Simple>.
 870
 871 =item C<json>
 872
 873 Should be a json file.  It will be read using the JSON library.  See L<JSON>.
 874
 875 =item C<html> and C<htm>
 876
 877 This is actually a custom type intended for use with CGI::Ex::Validate.
 878 The configuration to be read is actually validation that is stored
 879 inline with the html.  The handler will look for any form elements or
 880 input elements with an attribute with the same name as in $HTML_KEY.  It
 881 will also look for a javascript variable by the same name as in $HTML_KEY.
 882 All configuration items done this way should be written in YAML.
 883 For example, if $HTML_KEY contained 'validation' it would find validation in:
 884
 885   <input type=text name=username validation="{required: 1}">
 886   # automatically indented and "username:\n" prepended
 887   # AND #
 888   <form name=foo validation="
 889   general no_confirm: 1
 890   ">
 891   # AND #
 892   <script>
 893   document.validation = "\n\
 894   username: {required: 1}\n\
 895   ";
 896   </script>
 897   # AND #
 898   <script>
 899   var validation = "\n\
 900   username: {required: 1}\n\
 901   ";
 902   </script>
 903
 904 If the key $HTML_KEY is not set, the handler will always return undef
 905 without even opening the file.
 906
 907 =back
 908
 909 =head1 TODO
 910
 911 Make a similar write method that handles immutability.
 912
 913 =head1 LICENSE
 914
 915 This module may be distributed under the same terms as Perl itself.
 916
 917 =head1 AUTHOR
 918
 919 Paul Seamons <perl at seamons dot com>
 920
 921 =cut
 922