]> Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Conf.pm
322fd1c1c80649fc7f3ad5fc52eb8fab4973d70b
[chaz/p5-CGI-Ex] / 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 in_cache);
30
31 $VERSION = '2.04';
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
589 ### what extensions do we look for
590 my %EXT;
591 if ($self->{'handler'}) {
592 if (UNIVERSAL::isa($self->{'handler'},'HASH')) {
593 %EXT = %{ $self->{'handler'} };
594 }
595 } else {
596 %EXT = %EXT_READERS;
597 if (! $self->{'html_key'} && ! $HTML_KEY) {
598 delete $EXT{$_} foreach qw(html htm);
599 }
600 }
601 return if ! keys %EXT;
602
603 ### look in the paths for the files
604 foreach my $path (ref($paths) ? @$paths : $paths) {
605 $path =~ s|//+|/|g;
606 $path =~ s|/$||;
607 next if exists $CACHE{$path};
608 if (-f $path) {
609 my $ext = ($path =~ /\.(\w+)$/) ? $1 : '';
610 next if ! $EXT{$ext};
611 $CACHE{$path} = $self->read($path);
612 } elsif (-d _) {
613 $CACHE{$path} = 1;
614 require File::Find;
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 sub in_cache {
630 my ($self, $file) = (@_ == 2) ? @_ : (undef, shift());
631 return exists($CACHE{$file}) || 0;
632 }
633
634 ###----------------------------------------------------------------###
635
636 1;
637
638 __END__
639
640 =head1 SYNOPSIS
641
642 use CGI::Ex::Conf qw(conf_read conf_write);
643
644 my $hash = conf_read("/tmp/foo.yaml");
645
646 conf_write("/tmp/foo.yaml", {key1 => $val1, key2 => $val2});
647
648
649 ### OOP interface
650
651 my $cob = CGI::Ex::Conf->new;
652
653 my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml
654 my $hash = $cob->read($file);
655
656 local $cob->{default_ext} = 'conf'; # default anyway
657
658
659 my @paths = qw(/tmp, /home/pauls);
660 local $cob->{paths} = \@paths;
661 my $hash = $cob->read('My::NameSpace');
662 # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf
663
664
665 my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']});
666 # will look in /tmp/My/NameSpace.conf
667
668
669 local $cob->{directive} = 'MERGE';
670 my $hash = $cob->read('FooSpace');
671 # OR #
672 my $hash = $cob->read('FooSpace', {directive => 'MERGE'});
673 # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf
674 # immutable keys are preserved from originating files
675
676
677 local $cob->{directive} = 'FIRST';
678 my $hash = $cob->read('FooSpace');
679 # will return values from first found file in the path.
680
681
682 local $cob->{directive} = 'LAST'; # default behavior
683 my $hash = $cob->read('FooSpace');
684 # will return values from last found file in the path.
685
686
687 ### manipulate $hash
688 $cob->write('FooSpace'); # will write it out the changes
689
690 =head1 DESCRIPTION
691
692 There are half a million Conf readers out there. Why not add one more.
693 Actually, this module provides a wrapper around the many file formats
694 and the config modules that can handle them. It does not introduce any
695 formats of its own.
696
697 This module also provides a preload ability which is useful in conjunction
698 with mod_perl.
699
700 Oh - and it writes too.
701
702 =head1 METHODS
703
704 =over 4
705
706 =item C<read_ref>
707
708 Takes a file and optional argument hashref. Figures out the type
709 of handler to use to read the file, reads it and returns the ref.
710 If you don't need the extended merge functionality, or key fallback,
711 or immutable keys, or path lookup ability - then use this method.
712 Otherwise - use ->read.
713
714 =item C<read>
715
716 First argument may be either a perl data structure, yaml string, a
717 full filename, or a file "namespace".
718
719 The second argument can be a hashref of override values (referred to
720 as $args below)..
721
722 If the first argument is a perl data structure, it will be
723 copied one level deep and returned (nested structures will contain the
724 same references). A yaml string will be parsed and returned. A full
725 filename will be read using the appropriate handler and returned (a
726 file beginning with a / or ./ or ../ is considered to be a full
727 filename). A file "namespace" (ie "footer" or "my::config" or
728 "what/ever") will be turned into a filename by looking for that
729 namespace in the paths found either in $args->{paths} or in
730 $self->{paths} or in @DEFAULT_PATHS. @DEFAULT_PATHS is empty by
731 default as is $self->{paths} - read makes no attempt to guess what
732 directories to look in. If the namespace has no extension the
733 extension listed in $args->{default_ext} or $self->{default_ext} or
734 $DEFAULT_EXT will be used).
735
736 my $ref = $cob->read('My::NameSpace', {
737 paths => [qw(/tmp /usr/data)],
738 default_ext => 'pl',
739 });
740 # would look first for /tmp/My/NameSpace.pl
741 # and then /usr/data/My/NameSpace.pl
742
743 my $ref = $cob->read('foo.sto', {
744 paths => [qw(/tmp /usr/data)],
745 default_ext => 'pl',
746 });
747 # would look first for /tmp/foo.sto
748 # and then /usr/data/foo.sto
749
750 When a namespace is used and there are multiple possible paths, there
751 area a few options to control which file to look for. A directive of
752 'FIRST', 'MERGE', or 'LAST' may be specified in $args->{directive} or
753 $self->{directive} or the default value in $DIRECTIVE will be used
754 (default is 'LAST'). When 'FIRST' is specified the first path that
755 contains the namespace is returned. If 'LAST' is used, the last
756 found path that contains the namespace is returned. If 'MERGE' is
757 used, the data structures are joined together. If they are
758 arrayrefs, they are joined into one large arrayref. If they are
759 hashes, they are layered on top of each other with keys found in later
760 paths overwriting those found in earlier paths. This allows for
761 setting system defaults in a root file, and then allow users to have
762 custom overrides.
763
764 It is possible to make keys in a root file be immutable (non
765 overwritable) by adding a suffix of _immutable or _immu to the key (ie
766 {foo_immutable => 'bar'}). If a value is found in the file that
767 matches $IMMUTABLE_KEY, the entire file is considered immutable.
768 The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY.
769
770 Errors during read die. If the file does not exist undef is returned.
771
772 =item C<write_ref>
773
774 Takes a file and the reference to be written. Figures out the type
775 of handler to use to write the file and writes it. If you used the ->read_ref
776 use this method. Otherwise, use ->write.
777
778 =item C<write>
779
780 Allows for writing back out the information read in by ->read. If multiple
781 paths where used - the directive 'FIRST' will write the changes to the first
782 file in the path - otherwise the last path will be used. If ->read had found
783 immutable keys, then those keys are removed before writing.
784
785 Errors during write die.
786
787 =item C<preload_files>
788
789 Arguments are file(s) and/or directory(s) to preload. preload_files will
790 loop through the arguments, find the files that exist, read them in using
791 the handler which matches the files extension, and cache them by filename
792 in %CACHE. Directories are spidered for file extensions which match those
793 listed in %EXT_READERS. This is useful for a server environment where CPU
794 may be more precious than memory.
795
796 =item C<in_cache>
797
798 Allow for testing if a particular filename is registered in the %CACHE - typically
799 from a preload_files call. This is useful when building wrappers around the
800 conf_read and conf_write method calls.
801
802 =back
803
804 =head1 FUNCTIONS
805
806 =over4
807
808 =item conf_read
809
810 Takes a filename. Returns the read contents of that filename. The handler
811 to use is based upon the extention on the file.
812
813 my $hash = conf_read('/tmp/foo.yaml');
814
815 my $hash = conf_read('/tmp/foo', {file_type => 'yaml'});
816
817 Takes a filename and a data structure. Writes the data to the filename. The handler
818 to use is based upon the extention on the file.
819
820 conf_write('/tmp/foo.yaml', \%hash);
821
822 conf_write('/tmp/foo', \%hash, {file_type => 'yaml'});
823
824 =back
825
826 =head1 FILETYPES
827
828 CGI::Ex::Conf supports the files found in %EXT_READERS by default.
829 Additional types may be added to %EXT_READERS, or a custom handler may be
830 passed via $args->{handler} or $self->{handler}. If the custom handler is
831 a code ref, all files will be passed to it. If it is a hashref, it should
832 contain keys which are extensions it supports, and values which read those
833 extensions.
834
835 Some file types have benefits over others. Storable is very fast, but is
836 binary and not human readable. YAML is readable but very slow. I would
837 suggest using a readable format such as YAML and then using preload_files
838 to load in what you need at run time. All preloaded files are faster than
839 any of the other types.
840
841 The following is the list of handlers that ships with CGI::Ex::Conf (they
842 will only work if the supporting module is installed on your system):
843
844 =over 4
845
846 =item C<pl>
847
848 Should be a file containing a perl structure which is the last thing returned.
849
850 =item C<sto> and C<storable>
851
852 Should be a file containing a structure stored in Storable format.
853 See L<Storable>.
854
855 =item C<yaml> and C<conf> and C<val>
856
857 Should be a file containing a yaml document. Multiple documents are returned
858 as a single arrayref. Also - any file without an extension and custom handler
859 will be read using YAML. See L<YAML>.
860
861 =item C<ini>
862
863 Should be a windows style ini file. See L<Config::IniHash>
864
865 =item C<xml>
866
867 Should be an xml file. It will be read in by XMLin. See L<XML::Simple>.
868
869 =item C<html> and C<htm>
870
871 This is actually a custom type intended for use with CGI::Ex::Validate.
872 The configuration to be read is actually validation that is stored
873 inline with the html. The handler will look for any form elements or
874 input elements with an attribute with the same name as in $HTML_KEY. It
875 will also look for a javascript variable by the same name as in $HTML_KEY.
876 All configuration items done this way should be written in YAML.
877 For example, if $HTML_KEY contained 'validation' it would find validation in:
878
879 <input type=text name=username validation="{required: 1}">
880 # automatically indented and "username:\n" prepended
881 # AND #
882 <form name=foo validation="
883 general no_confirm: 1
884 ">
885 # AND #
886 <script>
887 document.validation = "\n\
888 username: {required: 1}\n\
889 ";
890 </script>
891 # AND #
892 <script>
893 var validation = "\n\
894 username: {required: 1}\n\
895 ";
896 </script>
897
898 If the key $HTML_KEY is not set, the handler will always return undef
899 without even opening the file.
900
901 =back
902
903 =head1 TODO
904
905 Make a similar write method that handles immutability.
906
907 =head1 AUTHOR
908
909 Paul Seamons
910
911 =head1 LICENSE
912
913 This module may be distributed under the same terms as Perl itself.
914
915 =cut
916
This page took 0.092886 seconds and 3 git commands to generate.