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