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