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 2006 - 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             );
  29 @EXPORT_OK = qw(conf_read conf_write);
  30
  31 $VERSION = '2.00';
  32
  33 $DEFAULT_EXT = 'conf';
  34
  35 %EXT_READERS = (''         => \&read_handler_yaml,
  36                 'conf'     => \&read_handler_yaml,
  37                 'json'     => \&read_handler_json,
  38                 'val_json' => \&read_handler_json,
  39                 'ini'      => \&read_handler_ini,
  40                 'pl'       => \&read_handler_pl,
  41                 'sto'      => \&read_handler_storable,
  42                 'storable' => \&read_handler_storable,
  43                 'val'      => \&read_handler_yaml,
  44                 'xml'      => \&read_handler_xml,
  45                 'yaml'     => \&read_handler_yaml,
  46                 'yml'      => \&read_handler_yaml,
  47                 'html'     => \&read_handler_html,
  48                 'htm'      => \&read_handler_html,
  49                 );
  50
  51 %EXT_WRITERS = (''         => \&write_handler_yaml,
  52                 'conf'     => \&write_handler_yaml,
  53                 'ini'      => \&write_handler_ini,
  54                 'json'     => \&write_handler_json,
  55                 'val_json' => \&write_handler_json,
  56                 'pl'       => \&write_handler_pl,
  57                 'sto'      => \&write_handler_storable,
  58                 'storable' => \&write_handler_storable,
  59                 'val'      => \&write_handler_yaml,
  60                 'xml'      => \&write_handler_xml,
  61                 'yaml'     => \&write_handler_yaml,
  62                 'yml'      => \&write_handler_yaml,
  63                 'html'     => \&write_handler_html,
  64                 'htm'      => \&write_handler_html,
  65                 );
  66
  67 ### $DIRECTIVE controls how files are looked for when namespaces are not absolute.
  68 ### If directories 1, 2 and 3 are passed and each has a config file
  69 ### LAST would return 3, FIRST would return 1, and MERGE will
  70 ### try to put them all together.  Merge behavior of hashes
  71 ### is determined by $IMMUTABLE_\w+ variables.
  72 $DIRECTIVE = 'LAST'; # LAST, MERGE, FIRST
  73
  74 $IMMUTABLE_QR = qr/_immu(?:table)?$/i;
  75
  76 $IMMUTABLE_KEY = 'immutable';
  77
  78 ###----------------------------------------------------------------###
  79
  80 sub new {
  81   my $class = shift || __PACKAGE__;
  82   my $args  = shift || {};
  83
  84   return bless {%$args}, $class;
  85 }
  86
  87 sub paths {
  88   my $self = shift;
  89   return $self->{paths} ||= \@DEFAULT_PATHS;
  90 }
  91
  92 ###----------------------------------------------------------------###
  93
  94 sub conf_read {
  95   my $file = shift;
  96   my $args = shift || {};
  97   my $ext;
  98
  99   ### they passed the right stuff already
 100   if (ref $file) {
 101     if (UNIVERSAL::isa($file, 'SCALAR')) {
 102       if ($$file =~ /^\s*</) {
 103         return html_parse_yaml_load($$file, $args); # allow for ref to a YAML string
 104       } else {
 105         return yaml_load($$file); # allow for ref to a YAML string
 106       }
 107     } else {
 108       return $file;
 109     }
 110
 111   ### allow for a pre-cached reference
 112   } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
 113     return $CACHE{$file};
 114
 115   ### if contains a newline - treat it as a YAML string
 116   } elsif (index($file,"\n") != -1) {
 117     return yaml_load($file);
 118
 119   ### otherwise base it off of the file extension
 120   } elsif ($args->{file_type}) {
 121     $ext = $args->{file_type};
 122   } elsif ($file =~ /\.(\w+)$/) {
 123     $ext = $1;
 124   } else {
 125     $ext = defined($args->{default_ext}) ? $args->{default_ext}
 126          : defined($DEFAULT_EXT)         ? $DEFAULT_EXT
 127          : '';
 128     $file = length($ext) ? "$file.$ext" : $file;
 129   }
 130
 131   ### determine the handler
 132   my $handler = $EXT_READERS{$ext} || croak "Unknown file extension: $ext";
 133
 134   return eval { scalar $handler->($file, $args) } || do {
 135     warn "Couldn't read $file: $@ " if ! $args->{no_warn_on_fail};
 136     return undef;
 137   };
 138 }
 139
 140 sub read_ref {
 141   my $self = shift;
 142   my $file = shift;
 143   my $args = shift || {};
 144   return conf_read($file, {%$self, %$args});
 145 }
 146
 147 ### allow for different kinds of merging of arguments
 148 ### allow for key fallback on hashes
 149 ### allow for immutable values on hashes
 150 sub read {
 151   my $self      = shift;
 152   my $namespace = shift;
 153   my $args      = shift || {};
 154   my $REF       = $args->{ref} || undef;    # can pass in existing set of options
 155   my $IMMUTABLE = $args->{immutable} || {}; # can pass existing immutable types
 156
 157   $self = $self->new() if ! ref $self;
 158
 159   ### allow for fast short ciruit on path lookup for several cases
 160   my $directive;
 161   my @paths = ();
 162   if (ref($namespace)                   # already a ref
 163       || index($namespace,"\n") != -1   # yaml string to read in
 164       || $namespace =~ m|^\.{0,2}/.+$|  # absolute or relative file
 165       ) {
 166     push @paths, $namespace;
 167     $directive = 'FIRST';
 168
 169   ### use the default directories
 170   } else {
 171     $directive = uc($args->{directive} || $self->{directive} || $DIRECTIVE);
 172     $namespace =~ s|::|/|g;  # allow perlish style namespace
 173     my $paths = $args->{paths} || $self->paths
 174       || croak "No paths found during read on $namespace";
 175     $paths = [$paths] if ! ref $paths;
 176     if ($directive eq 'LAST') { # LAST shall be FIRST
 177       $directive = 'FIRST';
 178       $paths = [reverse @$paths] if $#$paths != 0;
 179     }
 180     foreach my $path (@$paths) {
 181       next if exists $CACHE{$path} && ! $CACHE{$path};
 182       push @paths, "$path/$namespace";
 183     }
 184   }
 185
 186   ### make sure we have at least one path
 187   if ($#paths == -1) {
 188     croak "Couldn't find a path for namespace $namespace.  Perhaps you need to pass paths => \@paths";
 189   }
 190
 191   ### now loop looking for a ref
 192   foreach my $path (@paths) {
 193     my $ref = $self->read_ref($path, $args) || next;
 194     if (! $REF) {
 195       if (UNIVERSAL::isa($ref, 'ARRAY')) {
 196         $REF = [];
 197       } elsif (UNIVERSAL::isa($ref, 'HASH')) {
 198         $REF = {};
 199       } else {
 200         croak "Unknown config type of \"".ref($ref)."\" for namespace $namespace";
 201       }
 202     } elsif (! UNIVERSAL::isa($ref, ref($REF))) {
 203       croak "Found different reference types for namespace $namespace"
 204         . " - wanted a type ".ref($REF);
 205     }
 206     if (ref($REF) eq 'ARRAY') {
 207       if ($directive eq 'MERGE') {
 208         push @$REF, @$ref;
 209         next;
 210       }
 211       splice @$REF, 0, $#$REF + 1, @$ref;
 212       last;
 213     } else {
 214       my $immutable = delete $ref->{$IMMUTABLE_KEY};
 215       my ($key,$val);
 216       if ($directive eq 'MERGE') {
 217         while (($key,$val) = each %$ref) {
 218           next if $IMMUTABLE->{$key};
 219           my $immute = $key =~ s/$IMMUTABLE_QR//o;
 220           $IMMUTABLE->{$key} = 1 if $immute || $immutable;
 221           $REF->{$key} = $val;
 222         }
 223         next;
 224       }
 225       delete $REF->{$key} while $key = each %$REF;
 226       while (($key,$val) = each %$ref) {
 227         my $immute = $key =~ s/$IMMUTABLE_QR//o;
 228         $IMMUTABLE->{$key} = 1 if $immute || $immutable;
 229         $REF->{$key} = $val;
 230       }
 231       last;
 232     }
 233   }
 234   $REF->{"Immutable Keys"} = $IMMUTABLE if scalar keys %$IMMUTABLE;
 235   return $REF;
 236 }
 237
 238 ###----------------------------------------------------------------###
 239
 240 sub read_handler_ini {
 241   my $file = shift;
 242   require Config::IniHash;
 243   return Config::IniHash::ReadINI($file);
 244 }
 245
 246 sub read_handler_pl {
 247   my $file = shift;
 248   ### do has odd behavior in that it turns a simple hashref
 249   ### into hash - help it out a little bit
 250   my @ref = do $file;
 251   return ($#ref != 0) ? {@ref} : $ref[0];
 252 }
 253
 254 sub read_handler_json {
 255   my $file = shift;
 256   local *IN;
 257   open (IN, $file) || die "Couldn't open $file: $!";
 258   CORE::read(IN, my $text, -s $file);
 259   close IN;
 260   return scalar JSON::jsonToObj($text);
 261 }
 262
 263 sub read_handler_storable {
 264   my $file = shift;
 265   require Storable;
 266   return Storable::retrieve($file);
 267 }
 268
 269 sub read_handler_yaml {
 270   my $file = shift;
 271   local *IN;
 272   open (IN, $file) || die "Couldn't open $file: $!";
 273   CORE::read(IN, my $text, -s $file);
 274   close IN;
 275   return yaml_load($text);
 276 }
 277
 278 sub yaml_load {
 279   my $text = shift;
 280   require YAML;
 281   my @ret = eval { YAML::Load($text) };
 282   if ($@) {
 283     die "$@";
 284   }
 285   return ($#ret == 0) ? $ret[0] : \@ret;
 286 }
 287
 288 sub read_handler_xml {
 289   my $file = shift;
 290   require XML::Simple;
 291   return XML::Simple::XMLin($file);
 292 }
 293
 294 ### this handler will only function if a html_key (such as validation)
 295 ### is specified - actually this somewhat specific to validation - but
 296 ### I left it as a general use for other types
 297
 298 ### is specified
 299 sub read_handler_html {
 300   my $file = shift;
 301   my $args = shift;
 302   if (! eval { require YAML }) {
 303     my $err   = $@;
 304     my $found = 0;
 305     my $i     = 0;
 306     while (my($pkg, $file, $line, $sub) = caller($i++)) {
 307       return undef if $sub =~ /\bpreload_files$/;
 308     }
 309     die $err;
 310   }
 311
 312   ### get the html
 313   local *IN;
 314   open (IN, $file) || return undef;
 315   CORE::read(IN, my $html, -s $file);
 316   close IN;
 317
 318   return html_parse_yaml_load($html, $args);
 319 }
 320
 321 sub html_parse_yaml_load {
 322   my $html = shift;
 323   my $args = shift || {};
 324   my $key  = $args->{html_key} || $HTML_KEY;
 325   return undef if ! $key || $key !~ /^\w+$/;
 326
 327   my $str = '';
 328   my @order = ();
 329   while ($html =~ m{
 330     (document\.    # global javascript
 331      | var\s+      # local javascript
 332      | <\w+\s+[^>]*?) # input, form, select, textarea tag
 333       \Q$key\E   # the key
 334       \s*=\s*    # an equals sign
 335       ([\"\'])   # open quote
 336       (.+?[^\\]) # something in between
 337       \2        # close quote
 338     }xsg) {
 339     my ($line, $quot, $yaml) = ($1, $2, $3);
 340     if ($line =~ /^(document\.|var\s)/) { # js variable
 341       $yaml =~ s/\\$quot/$quot/g;
 342       $yaml =~ s/\\n\\\n?/\n/g;
 343       $yaml =~ s/\\\\/\\/g;
 344       $yaml =~ s/\s*$/\n/s; # fix trailing newline
 345       $str = $yaml; # use last one found
 346     } else { # inline attributes
 347       $yaml =~ s/\s*$/\n/s; # fix trailing newline
 348       if ($line =~ m/<form/i) {
 349         $yaml =~ s/^\Q$1\E//m if $yaml =~ m/^( +)/s;
 350         $str .= $yaml;
 351
 352       } elsif ($line =~ m/\bname\s*=\s*('[^\']*'|"[^\"]*"|\S+)/) {
 353         my $key = $1;
 354         push @order, $key;
 355         $yaml =~ s/^/ /mg; # indent entire thing
 356         $yaml =~ s/^(\ *[^\s&*\{\[])/\n$1/; # add first newline
 357         $str .= "$key:$yaml";
 358       }
 359     }
 360   }
 361   $str .= "group order: [".join(", ",@order)."]\n"
 362     if $str && $#order != -1 && $key eq 'validation';
 363
 364   return undef if ! $str;
 365   my $ref = eval { yaml_load($str) };
 366   if ($@) {
 367     my $err = "$@";
 368     if ($err =~ /line:\s+(\d+)/) {
 369       my $line = $1;
 370       while ($str =~ m/(.+)/gm) {
 371         next if -- $line;
 372         $err .= "LINE = \"$1\"\n";
 373         last;
 374       }
 375     }
 376     die $err;
 377   }
 378   return $ref;
 379 }
 380
 381 ###----------------------------------------------------------------###
 382
 383 sub conf_write {
 384   my $file = shift;
 385   my $conf = shift || croak "Missing conf";
 386   my $args = shift || {};
 387   my $ext;
 388
 389   if (ref $file) {
 390     croak "Invalid filename for write: $file";
 391
 392   } elsif (index($file,"\n") != -1) {
 393     croak "Cannot use a yaml string as a filename during write";
 394
 395   ### allow for a pre-cached reference
 396   } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
 397     warn "Cannot write back to a file that is in the cache";
 398     return 0;
 399
 400   ### otherwise base it off of the file extension
 401   } elsif ($args->{file_type}) {
 402     $ext = $args->{file_type};
 403   } elsif ($file =~ /\.(\w+)$/) {
 404     $ext = $1;
 405   } else {
 406     $ext = defined($args->{default_ext}) ? $args->{default_ext}
 407          : defined($DEFAULT_EXT)         ? $DEFAULT_EXT
 408          : '';
 409     $file = length($ext) ? "$file.$ext" : $file;
 410   }
 411
 412   ### determine the handler
 413   my $handler;
 414   if ($args->{handler}) {
 415     $handler = (UNIVERSAL::isa($args->{handler},'CODE'))
 416       ? $args->{handler} : $args->{handler}->{$ext};
 417   }
 418   if (! $handler) {
 419     $handler = $EXT_WRITERS{$ext} || croak "Unknown file extension: $ext";
 420   }
 421
 422   return eval { scalar $handler->($file, $conf, $args) } || do {
 423     warn "Couldn't write $file: $@ " if ! $args->{no_warn_on_fail};
 424     return 0;
 425   };
 426
 427   return 1;
 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   require File::Find;
 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       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 ###----------------------------------------------------------------###
 631
 632 1;
 633
 634 __END__
 635
 636 =head1 SYNOPSIS
 637
 638   my $cob = CGI::Ex::Conf->new;
 639
 640   my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml
 641   my $hash = $cob->read($file);
 642
 643   local $cob->{default_ext} = 'conf'; # default anyway
 644
 645
 646   my @paths = qw(/tmp, /home/pauls);
 647   local $cob->{paths} = \@paths;
 648   my $hash = $cob->read('My::NameSpace');
 649   # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf
 650
 651   my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']});
 652   # will look in /tmp/My/NameSpace.conf
 653
 654
 655   local $cob->{directive} = 'MERGE';
 656   my $hash = $cob->read('FooSpace');
 657   # OR #
 658   my $hash = $cob->read('FooSpace', {directive => 'MERGE'});
 659   # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf
 660   # immutable keys are preserved from originating files
 661
 662
 663   local $cob->{directive} = 'FIRST';
 664   my $hash = $cob->read('FooSpace');
 665   # will return values from first found file in the path.
 666
 667
 668   local $cob->{directive} = 'LAST'; # default behavior
 669   my $hash = $cob->read('FooSpace');
 670   # will return values from last found file in the path.
 671
 672
 673   ### manipulate $hash
 674   $cob->write('FooSpace'); # will write it out the changes
 675
 676 =head1 DESCRIPTION
 677
 678 There are half a million Conf readers out there.  Why not add one more.
 679 Actually, this module provides a wrapper around the many file formats
 680 and the config modules that can handle them.  It does not introduce any
 681 formats of its own.
 682
 683 This module also provides a preload ability which is useful in conjunction
 684 with mod_perl.
 685
 686 Oh - and it writes too.
 687
 688 =head1 METHODS
 689
 690 =over 4
 691
 692 =item C<-E<gt>read_ref>
 693
 694 Takes a file and optional argument hashref.  Figures out the type
 695 of handler to use to read the file, reads it and returns the ref.
 696 If you don't need the extended merge functionality, or key fallback,
 697 or immutable keys, or path lookup ability - then use this method.
 698 Otherwise - use ->read.
 699
 700 =item C<-E<gt>read>
 701
 702 First argument may be either a perl data structure, yaml string, a
 703 full filename, or a file "namespace".
 704
 705 The second argument can be a hashref of override values (referred to
 706 as $args below)..
 707
 708 If the first argument is a perl data structure, it will be
 709 copied one level deep and returned (nested structures will contain the
 710 same references).  A yaml string will be parsed and returned.  A full
 711 filename will be read using the appropriate handler and returned (a
 712 file beginning with a / or ./ or ../ is considered to be a full
 713 filename).  A file "namespace" (ie "footer" or "my::config" or
 714 "what/ever") will be turned into a filename by looking for that
 715 namespace in the paths found either in $args->{paths} or in
 716 $self->{paths} or in @DEFAULT_PATHS.  @DEFAULT_PATHS is empty by
 717 default as is $self->{paths} - read makes no attempt to guess what
 718 directories to look in.  If the namespace has no extension the
 719 extension listed in $args->{default_ext} or $self->{default_ext} or
 720 $DEFAULT_EXT will be used).
 721
 722   my $ref = $cob->read('My::NameSpace', {
 723     paths => [qw(/tmp /usr/data)],
 724     default_ext => 'pl',
 725   });
 726   # would look first for /tmp/My/NameSpace.pl
 727   # and then /usr/data/My/NameSpace.pl
 728
 729   my $ref = $cob->read('foo.sto', {
 730     paths => [qw(/tmp /usr/data)],
 731     default_ext => 'pl',
 732   });
 733   # would look first for /tmp/foo.sto
 734   # and then /usr/data/foo.sto
 735
 736 When a namespace is used and there are multiple possible paths, there
 737 area a few options to control which file to look for.  A directive of
 738 'FIRST', 'MERGE', or 'LAST' may be specified in $args->{directive} or
 739 $self->{directive} or the default value in $DIRECTIVE will be used
 740 (default is 'LAST'). When 'FIRST' is specified the first path that
 741 contains the namespace is returned.  If 'LAST' is used, the last
 742 found path that contains the namespace is returned.  If 'MERGE' is
 743 used, the data structures are joined together.  If they are
 744 arrayrefs, they are joined into one large arrayref.  If they are
 745 hashes, they are layered on top of each other with keys found in later
 746 paths overwriting those found in earlier paths.  This allows for
 747 setting system defaults in a root file, and then allow users to have
 748 custom overrides.
 749
 750 It is possible to make keys in a root file be immutable (non
 751 overwritable) by adding a suffix of _immutable or _immu to the key (ie
 752 {foo_immutable => 'bar'}).  If a value is found in the file that
 753 matches $IMMUTABLE_KEY, the entire file is considered immutable.
 754 The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY.
 755
 756 =item C<-E<gt>write_ref>
 757
 758 Takes a file and the reference to be written.  Figures out the type
 759 of handler to use to write the file and writes it. If you used the ->read_ref
 760 use this method.  Otherwise, use ->write.
 761
 762 =item C<-E<gt>write>
 763
 764 Allows for writing back out the information read in by ->read.  If multiple
 765 paths where used - the directive 'FIRST' will write the changes to the first
 766 file in the path - otherwise the last path will be used.  If ->read had found
 767 immutable keys, then those keys are removed before writing.
 768
 769 =item C<-E<gt>preload_files>
 770
 771 Arguments are file(s) and/or directory(s) to preload.  preload_files will
 772 loop through the arguments, find the files that exist, read them in using
 773 the handler which matches the files extension, and cache them by filename
 774 in %CACHE.  Directories are spidered for file extensions which match those
 775 listed in %EXT_READERS.  This is useful for a server environment where CPU
 776 may be more precious than memory.
 777
 778 =head1 FILETYPES
 779
 780 CGI::Ex::Conf supports the files found in %EXT_READERS by default.
 781 Additional types may be added to %EXT_READERS, or a custom handler may be
 782 passed via $args->{handler} or $self->{handler}.  If the custom handler is
 783 a code ref, all files will be passed to it.  If it is a hashref, it should
 784 contain keys which are extensions it supports, and values which read those
 785 extensions.
 786
 787 Some file types have benefits over others.  Storable is very fast, but is
 788 binary and not human readable.  YAML is readable but very slow.  I would
 789 suggest using a readable format such as YAML and then using preload_files
 790 to load in what you need at run time.  All preloaded files are faster than
 791 any of the other types.
 792
 793 The following is the list of handlers that ships with CGI::Ex::Conf (they
 794 will only work if the supporting module is installed on your system):
 795
 796 =over 4
 797
 798 =item C<pl>
 799
 800 Should be a file containing a perl structure which is the last thing returned.
 801
 802 =item C<sto> and C<storable>
 803
 804 Should be a file containing a structure stored in Storable format.
 805 See L<Storable>.
 806
 807 =item C<yaml> and C<conf> and C<val>
 808
 809 Should be a file containing a yaml document.  Multiple documents are returned
 810 as a single arrayref.  Also - any file without an extension and custom handler
 811 will be read using YAML.  See L<YAML>.
 812
 813 =item C<ini>
 814
 815 Should be a windows style ini file.  See L<Config::IniHash>
 816
 817 =item C<xml>
 818
 819 Should be an xml file.  It will be read in by XMLin.  See L<XML::Simple>.
 820
 821 =item C<html> and C<htm>
 822
 823 This is actually a custom type intended for use with CGI::Ex::Validate.
 824 The configuration to be read is actually validation that is stored
 825 inline with the html.  The handler will look for any form elements or
 826 input elements with an attribute with the same name as in $HTML_KEY.  It
 827 will also look for a javascript variable by the same name as in $HTML_KEY.
 828 All configuration items done this way should be written in YAML.
 829 For example, if $HTML_KEY contained 'validation' it would find validation in:
 830
 831   <input type=text name=username validation="{required: 1}">
 832   # automatically indented and "username:\n" prepended
 833   # AND #
 834   <form name=foo validation="
 835   general no_confirm: 1
 836   ">
 837   # AND #
 838   <script>
 839   document.validation = "\n\
 840   username: {required: 1}\n\
 841   ";
 842   </script>
 843   # AND #
 844   <script>
 845   var validation = "\n\
 846   username: {required: 1}\n\
 847   ";
 848   </script>
 849
 850 If the key $HTML_KEY is not set, the handler will always return undef
 851 without even opening the file.
 852
 853 =back
 854
 855 =head1 TODO
 856
 857 Make a similar write method that handles immutability.
 858
 859 =head1 AUTHOR
 860
 861 Paul Seamons
 862
 863 =head1 LICENSE
 864
 865 This module may be distributed under the same terms as Perl itself.
 866
 867 =cut
 868