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

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