]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Conf.pm
5 CGI::Ex::Conf - Conf Reader/Writer for many different data format types
9 ###----------------------------------------------------------------###
10 # Copyright 2006 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
15 use base
qw(Exporter);
29 @EXPORT_OK = qw(conf_read conf_write);
33 $DEFAULT_EXT = 'conf';
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
,
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
,
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
74 $IMMUTABLE_QR = qr/_immu(?:table)?$/i;
76 $IMMUTABLE_KEY = 'immutable';
78 ###----------------------------------------------------------------###
81 my $class = shift || __PACKAGE__
;
82 my $args = shift || {};
84 return bless {%$args}, $class;
89 return $self->{paths
} ||= \
@DEFAULT_PATHS;
92 ###----------------------------------------------------------------###
96 my $args = shift || {};
99 ### they passed the right stuff already
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
105 return yaml_load
($$file); # allow for ref to a YAML string
111 ### allow for a pre-cached reference
112 } elsif (exists $CACHE{$file} && ! $args->{no_cache
}) {
113 return $CACHE{$file};
115 ### if contains a newline - treat it as a YAML string
116 } elsif (index($file,"\n") != -1) {
117 return yaml_load
($file);
119 ### otherwise base it off of the file extension
120 } elsif ($args->{file_type
}) {
121 $ext = $args->{file_type
};
122 } elsif ($file =~ /\.(\w+)$/) {
125 $ext = defined($args->{default_ext
}) ? $args->{default_ext
}
126 : defined($DEFAULT_EXT) ? $DEFAULT_EXT
128 $file = length($ext) ? "$file.$ext" : $file;
131 ### determine the handler
132 my $handler = $EXT_READERS{$ext} || croak
"Unknown file extension: $ext";
134 ### don't die if the file is not found - do die otherwise
136 eval { die "Conf file $file not found" };
137 warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'};
141 return eval { scalar $handler->($file, $args) } || die "Error while reading conf file $file\n$@";
147 my $args = shift || {};
148 return conf_read
($file, {%$self, %$args});
151 ### allow for different kinds of merging of arguments
152 ### allow for key fallback on hashes
153 ### allow for immutable values on hashes
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
161 $self = $self->new() if ! ref $self;
163 ### allow for fast short ciruit on path lookup for several cases
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
170 push @paths, $namespace;
171 $directive = 'FIRST';
173 ### use the default directories
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;
184 foreach my $path (@$paths) {
185 next if exists $CACHE{$path} && ! $CACHE{$path};
186 push @paths, "$path/$namespace";
190 ### make sure we have at least one path
192 croak
"Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
195 ### now loop looking for a ref
196 foreach my $path (@paths) {
197 my $ref = $self->read_ref($path, $args) || next;
199 if (UNIVERSAL
::isa
($ref, 'ARRAY')) {
201 } elsif (UNIVERSAL
::isa
($ref, 'HASH')) {
204 croak
"Unknown config type of \"".ref($ref)."\" for namespace $namespace";
206 } elsif (! UNIVERSAL
::isa
($ref, ref($REF))) {
207 croak
"Found different reference types for namespace $namespace"
208 . " - wanted a type ".ref($REF);
210 if (ref($REF) eq 'ARRAY') {
211 if ($directive eq 'MERGE') {
215 splice @$REF, 0, $#$REF + 1, @$ref;
218 my $immutable = delete $ref->{$IMMUTABLE_KEY};
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;
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;
238 $REF->{"Immutable Keys"} = $IMMUTABLE if scalar keys %$IMMUTABLE;
242 ###----------------------------------------------------------------###
244 sub read_handler_ini
{
246 require Config
::IniHash
;
247 return Config
::IniHash
::ReadINI
($file);
250 sub read_handler_pl
{
252 ### do has odd behavior in that it turns a simple hashref
253 ### into hash - help it out a little bit
255 return ($#ref != 0) ? {@ref} : $ref[0];
258 sub read_handler_json
{
261 open (IN
, $file) || die "Couldn't open $file: $!";
262 CORE
::read(IN
, my $text, -s
$file);
264 return scalar JSON
::jsonToObj
($text);
267 sub read_handler_storable
{
270 return Storable
::retrieve
($file);
273 sub read_handler_yaml
{
276 open (IN
, $file) || die "Couldn't open $file: $!";
277 CORE
::read(IN
, my $text, -s
$file);
279 return yaml_load
($text);
285 my @ret = eval { YAML
::Load
($text) };
289 return ($#ret == 0) ? $ret[0] : \
@ret;
292 sub read_handler_xml
{
295 return XML
::Simple
::XMLin
($file);
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
303 sub read_handler_html
{
306 if (! eval { require YAML
}) {
310 while (my($pkg, $file, $line, $sub) = caller($i++)) {
311 return undef if $sub =~ /\bpreload_files$/;
318 open (IN
, $file) || return undef;
319 CORE
::read(IN
, my $html, -s
$file);
322 return html_parse_yaml_load
($html, $args);
325 sub html_parse_yaml_load
{
327 my $args = shift || {};
328 my $key = $args->{html_key
} || $HTML_KEY;
329 return undef if ! $key || $key !~ /^\w+$/;
334 (document\
. # global javascript
335 | var\s
+ # local javascript
336 | <\w
+\s
+[^>]*?) # input, form, select, textarea tag
338 \s
*=\s
* # an equals sign
339 ([\"\']) # open quote
340 (.+?[^\\]) # something in between
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;
356 } elsif ($line =~ m/\bname\s*=\s*('[^\']*'|"[^\"]*"|\S+)/) {
359 $yaml =~ s/^/ /mg; # indent entire thing
360 $yaml =~ s/^(\ *[^\s&*\{\[])/\n$1/; # add first newline
361 $str .= "$key:$yaml";
365 $str .= "group order: [".join(", ",@order)."]\n"
366 if $str && $#order != -1 && $key eq 'validation';
368 return undef if ! $str;
369 my $ref = eval { yaml_load
($str) };
372 if ($err =~ /line:\s+(\d+)/) {
374 while ($str =~ m/(.+)/gm) {
376 $err .= "LINE = \"$1\"\n";
385 ###----------------------------------------------------------------###
389 my $conf = shift || croak
"Missing conf";
390 my $args = shift || {};
394 croak
"Invalid filename for write: $file";
396 } elsif (index($file,"\n") != -1) {
397 croak
"Cannot use a yaml string as a filename during write";
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";
404 ### otherwise base it off of the file extension
405 } elsif ($args->{file_type
}) {
406 $ext = $args->{file_type
};
407 } elsif ($file =~ /\.(\w+)$/) {
410 $ext = defined($args->{default_ext
}) ? $args->{default_ext
}
411 : defined($DEFAULT_EXT) ? $DEFAULT_EXT
413 $file = length($ext) ? "$file.$ext" : $file;
416 ### determine the handler
418 if ($args->{handler
}) {
419 $handler = (UNIVERSAL
::isa
($args->{handler
},'CODE'))
420 ? $args->{handler
} : $args->{handler
}->{$ext};
423 $handler = $EXT_WRITERS{$ext} || croak
"Unknown file extension: $ext";
426 return eval { scalar $handler->($file, $conf, $args) } || die "Error while writing conf file $file\n$@";
433 my $args = shift || {};
434 conf_write
($file, $conf, {%$self, %$args});
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
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
447 $self = $self->new() if ! ref $self;
449 ### allow for fast short ciruit on path lookup for several cases
452 if (ref($namespace) # already a ref
453 || $namespace =~ m
|^\
.{0,2}/.+$| # absolute or relative file
455 push @paths, $namespace;
456 $directive = 'FIRST';
458 } elsif (index($namespace,"\n") != -1) { # yaml string - can't write that
459 croak
"Cannot use a yaml string as a namespace for write";
461 ### use the default directories
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;
472 foreach my $path (@$paths) {
473 next if exists $CACHE{$path} && ! $CACHE{$path};
474 push @paths, "$path/$namespace";
478 ### make sure we have at least one path
480 croak
"Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
484 if ($directive eq 'FIRST') {
486 } elsif ($directive eq 'LAST' || $directive eq 'MERGE') {
489 croak
"Unknown directive ($directive) during write of $namespace";
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};
501 ### finally write it out
502 $self->write_ref($path, $conf);
507 ###----------------------------------------------------------------###
509 sub write_handler_ini
{
512 require Config
::IniHash
;
513 return Config
::IniHash
::WriteINI
($file, $ref);
516 sub write_handler_pl
{
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) {
530 $str =~ s/^\s{1,$l}//mg;
532 if ($str =~ /\$VunderVar/) {
533 die "Ref to be written contained circular references - can't write";
537 open (OUT
, ">$file") || die $!;
542 sub write_handler_json
{
546 my $str = JSON
::objToJson
($ref, {pretty
=> 1, indent
=> 2});
548 open (OUT
, ">$file") || die $!;
553 sub write_handler_storable
{
557 return Storable
::store
($ref, $file);
560 sub write_handler_yaml
{
564 return YAML
::DumpFile
($file, $ref);
567 sub write_handler_xml
{
572 open (OUT
, ">$file") || die $!;
573 print OUT
scalar(XML
::Simple-
>new->XMLout($ref, noattr
=> 1));
577 sub write_handler_html
{
580 die "Write of conf information to html is not supported";
583 ###----------------------------------------------------------------###
587 my $paths = shift || $self->paths;
590 ### what extensions do we look for
592 if ($self->{handler
}) {
593 if (UNIVERSAL
::isa
($self->{handler
},'HASH')) {
594 %EXT = %{ $self->{handler
} };
598 if (! $self->{html_key
} && ! $HTML_KEY) {
599 delete $EXT{$_} foreach qw(html htm);
602 return if ! keys %EXT;
604 ### look in the paths for the files
605 foreach my $path (ref($paths) ? @$paths : $paths) {
608 next if exists $CACHE{$path};
610 my $ext = ($path =~ /\.(\w+)$/) ? $1 : '';
611 next if ! $EXT{$ext};
612 $CACHE{$path} = $self->read($path);
615 File
::Find
::find
(sub {
616 return if exists $CACHE{$File::Find
::name
};
617 return if $File::Find
::name
=~ m
|/CVS/|;
619 my $ext = (/\.(\w+)$/) ? $1 : '';
620 return if ! $EXT{$ext};
621 $CACHE{$File::Find
::name
} = $self->read($File::Find
::name
);
629 ###----------------------------------------------------------------###
637 my $cob = CGI::Ex::Conf->new;
639 my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml
640 my $hash = $cob->read($file);
642 local $cob->{default_ext} = 'conf'; # default anyway
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
650 my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']});
651 # will look in /tmp/My/NameSpace.conf
654 local $cob->{directive} = 'MERGE';
655 my $hash = $cob->read('FooSpace');
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
662 local $cob->{directive} = 'FIRST';
663 my $hash = $cob->read('FooSpace');
664 # will return values from first found file in the path.
667 local $cob->{directive} = 'LAST'; # default behavior
668 my $hash = $cob->read('FooSpace');
669 # will return values from last found file in the path.
673 $cob->write('FooSpace'); # will write it out the changes
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
682 This module also provides a preload ability which is useful in conjunction
685 Oh - and it writes too.
691 =item C<-E<gt>read_ref>
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.
701 First argument may be either a perl data structure, yaml string, a
702 full filename, or a file "namespace".
704 The second argument can be a hashref of override values (referred to
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).
721 my $ref = $cob->read('My::NameSpace', {
722 paths => [qw(/tmp /usr/data)],
725 # would look first for /tmp/My/NameSpace.pl
726 # and then /usr/data/My/NameSpace.pl
728 my $ref = $cob->read('foo.sto', {
729 paths => [qw(/tmp /usr/data)],
732 # would look first for /tmp/foo.sto
733 # and then /usr/data/foo.sto
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
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.
755 Errors during read die. If the file does not exist undef is returned.
757 =item C<-E<gt>write_ref>
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.
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.
770 Errors during write die.
772 =item C<-E<gt>preload_files>
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.
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
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.
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):
803 Should be a file containing a perl structure which is the last thing returned.
805 =item C<sto> and C<storable>
807 Should be a file containing a structure stored in Storable format.
810 =item C<yaml> and C<conf> and C<val>
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>.
818 Should be a windows style ini file. See L<Config::IniHash>
822 Should be an xml file. It will be read in by XMLin. See L<XML::Simple>.
824 =item C<html> and C<htm>
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:
834 <input type=text name=username validation="{required: 1}">
835 # automatically indented and "username:\n" prepended
837 <form name=foo validation="
838 general no_confirm: 1
842 document.validation = "\n\
843 username: {required: 1}\n\
848 var validation = "\n\
849 username: {required: 1}\n\
853 If the key $HTML_KEY is not set, the handler will always return undef
854 without even opening the file.
860 Make a similar write method that handles immutability.
868 This module may be distributed under the same terms as Perl itself.
This page took 0.092314 seconds and 5 git commands to generate.