]>
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 return eval { scalar $handler->($file, $args) } || do {
135 warn "Couldn't read $file: $@ " if ! $args->{no_warn_on_fail
};
143 my $args = shift || {};
144 return conf_read
($file, {%$self, %$args});
147 ### allow for different kinds of merging of arguments
148 ### allow for key fallback on hashes
149 ### allow for immutable values on hashes
152 my $namespace = shift;
153 my $args = shift || {};
154 my $REF = $args->{ref} || undef; # can pass in existing set of options
155 my $IMMUTABLE = $args->{immutable
} || {}; # can pass existing immutable types
157 $self = $self->new() if ! ref $self;
159 ### allow for fast short ciruit on path lookup for several cases
162 if (ref($namespace) # already a ref
163 || index($namespace,"\n") != -1 # yaml string to read in
164 || $namespace =~ m
|^\
.{0,2}/.+$| # absolute or relative file
166 push @paths, $namespace;
167 $directive = 'FIRST';
169 ### use the default directories
171 $directive = uc($args->{directive
} || $self->{directive
} || $DIRECTIVE);
172 $namespace =~ s
|::|/|g
; # allow perlish style namespace
173 my $paths = $args->{paths
} || $self->paths
174 || croak
"No paths found during read on $namespace";
175 $paths = [$paths] if ! ref $paths;
176 if ($directive eq 'LAST') { # LAST shall be FIRST
177 $directive = 'FIRST';
178 $paths = [reverse @$paths] if $#$paths != 0;
180 foreach my $path (@$paths) {
181 next if exists $CACHE{$path} && ! $CACHE{$path};
182 push @paths, "$path/$namespace";
186 ### make sure we have at least one path
188 croak
"Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
191 ### now loop looking for a ref
192 foreach my $path (@paths) {
193 my $ref = $self->read_ref($path, $args) || next;
195 if (UNIVERSAL
::isa
($ref, 'ARRAY')) {
197 } elsif (UNIVERSAL
::isa
($ref, 'HASH')) {
200 croak
"Unknown config type of \"".ref($ref)."\" for namespace $namespace";
202 } elsif (! UNIVERSAL
::isa
($ref, ref($REF))) {
203 croak
"Found different reference types for namespace $namespace"
204 . " - wanted a type ".ref($REF);
206 if (ref($REF) eq 'ARRAY') {
207 if ($directive eq 'MERGE') {
211 splice @$REF, 0, $#$REF + 1, @$ref;
214 my $immutable = delete $ref->{$IMMUTABLE_KEY};
216 if ($directive eq 'MERGE') {
217 while (($key,$val) = each %$ref) {
218 next if $IMMUTABLE->{$key};
219 my $immute = $key =~ s/$IMMUTABLE_QR//o;
220 $IMMUTABLE->{$key} = 1 if $immute || $immutable;
225 delete $REF->{$key} while $key = each %$REF;
226 while (($key,$val) = each %$ref) {
227 my $immute = $key =~ s/$IMMUTABLE_QR//o;
228 $IMMUTABLE->{$key} = 1 if $immute || $immutable;
234 $REF->{"Immutable Keys"} = $IMMUTABLE if scalar keys %$IMMUTABLE;
238 ###----------------------------------------------------------------###
240 sub read_handler_ini
{
242 require Config
::IniHash
;
243 return Config
::IniHash
::ReadINI
($file);
246 sub read_handler_pl
{
248 ### do has odd behavior in that it turns a simple hashref
249 ### into hash - help it out a little bit
251 return ($#ref != 0) ? {@ref} : $ref[0];
254 sub read_handler_json
{
257 open (IN
, $file) || die "Couldn't open $file: $!";
258 CORE
::read(IN
, my $text, -s
$file);
260 return scalar JSON
::jsonToObj
($text);
263 sub read_handler_storable
{
266 return Storable
::retrieve
($file);
269 sub read_handler_yaml
{
272 open (IN
, $file) || die "Couldn't open $file: $!";
273 CORE
::read(IN
, my $text, -s
$file);
275 return yaml_load
($text);
281 my @ret = eval { YAML
::Load
($text) };
285 return ($#ret == 0) ? $ret[0] : \
@ret;
288 sub read_handler_xml
{
291 return XML
::Simple
::XMLin
($file);
294 ### this handler will only function if a html_key (such as validation)
295 ### is specified - actually this somewhat specific to validation - but
296 ### I left it as a general use for other types
299 sub read_handler_html
{
302 if (! eval { require YAML
}) {
306 while (my($pkg, $file, $line, $sub) = caller($i++)) {
307 return undef if $sub =~ /\bpreload_files$/;
314 open (IN
, $file) || return undef;
315 CORE
::read(IN
, my $html, -s
$file);
318 return html_parse_yaml_load
($html, $args);
321 sub html_parse_yaml_load
{
323 my $args = shift || {};
324 my $key = $args->{html_key
} || $HTML_KEY;
325 return undef if ! $key || $key !~ /^\w+$/;
330 (document\
. # global javascript
331 | var\s
+ # local javascript
332 | <\w
+\s
+[^>]*?) # input, form, select, textarea tag
334 \s
*=\s
* # an equals sign
335 ([\"\']) # open quote
336 (.+?[^\\]) # something in between
339 my ($line, $quot, $yaml) = ($1, $2, $3);
340 if ($line =~ /^(document\.|var\s)/) { # js variable
341 $yaml =~ s/\\$quot/$quot/g;
342 $yaml =~ s/\\n\\\n?/\n/g;
343 $yaml =~ s/\\\\/\\/g;
344 $yaml =~ s/\s*$/\n/s; # fix trailing newline
345 $str = $yaml; # use last one found
346 } else { # inline attributes
347 $yaml =~ s/\s*$/\n/s; # fix trailing newline
348 if ($line =~ m/<form/i) {
349 $yaml =~ s/^\Q$1\E//m if $yaml =~ m/^( +)/s;
352 } elsif ($line =~ m/\bname\s*=\s*('[^\']*'|"[^\"]*"|\S+)/) {
355 $yaml =~ s/^/ /mg; # indent entire thing
356 $yaml =~ s/^(\ *[^\s&*\{\[])/\n$1/; # add first newline
357 $str .= "$key:$yaml";
361 $str .= "group order: [".join(", ",@order)."]\n"
362 if $str && $#order != -1 && $key eq 'validation';
364 return undef if ! $str;
365 my $ref = eval { yaml_load
($str) };
368 if ($err =~ /line:\s+(\d+)/) {
370 while ($str =~ m/(.+)/gm) {
372 $err .= "LINE = \"$1\"\n";
381 ###----------------------------------------------------------------###
385 my $conf = shift || croak
"Missing conf";
386 my $args = shift || {};
390 croak
"Invalid filename for write: $file";
392 } elsif (index($file,"\n") != -1) {
393 croak
"Cannot use a yaml string as a filename during write";
395 ### allow for a pre-cached reference
396 } elsif (exists $CACHE{$file} && ! $args->{no_cache
}) {
397 warn "Cannot write back to a file that is in the cache";
400 ### otherwise base it off of the file extension
401 } elsif ($args->{file_type
}) {
402 $ext = $args->{file_type
};
403 } elsif ($file =~ /\.(\w+)$/) {
406 $ext = defined($args->{default_ext
}) ? $args->{default_ext
}
407 : defined($DEFAULT_EXT) ? $DEFAULT_EXT
409 $file = length($ext) ? "$file.$ext" : $file;
412 ### determine the handler
414 if ($args->{handler
}) {
415 $handler = (UNIVERSAL
::isa
($args->{handler
},'CODE'))
416 ? $args->{handler
} : $args->{handler
}->{$ext};
419 $handler = $EXT_WRITERS{$ext} || croak
"Unknown file extension: $ext";
422 return eval { scalar $handler->($file, $conf, $args) } || do {
423 warn "Couldn't write $file: $@ " if ! $args->{no_warn_on_fail
};
434 my $args = shift || {};
435 conf_write
($file, $conf, {%$self, %$args});
438 ### Allow for writing out conf values
439 ### Allow for writing out the correct filename (if there is a path array)
440 ### Allow for not writing out immutable values on hashes
443 my $namespace = shift;
444 my $conf = shift || croak
"Must pass hashref to write out"; # the info to write
445 my $args = shift || {};
446 my $IMMUTABLE = $args->{immutable
} || {}; # can pass existing immutable types
448 $self = $self->new() if ! ref $self;
450 ### allow for fast short ciruit on path lookup for several cases
453 if (ref($namespace) # already a ref
454 || $namespace =~ m
|^\
.{0,2}/.+$| # absolute or relative file
456 push @paths, $namespace;
457 $directive = 'FIRST';
459 } elsif (index($namespace,"\n") != -1) { # yaml string - can't write that
460 croak
"Cannot use a yaml string as a namespace for write";
462 ### use the default directories
464 $directive = uc($args->{directive
} || $self->{directive
} || $DIRECTIVE);
465 $namespace =~ s
|::|/|g
; # allow perlish style namespace
466 my $paths = $args->{paths
} || $self->paths
467 || croak
"No paths found during write on $namespace";
468 $paths = [$paths] if ! ref $paths;
469 if ($directive eq 'LAST') { # LAST shall be FIRST
470 $directive = 'FIRST';
471 $paths = [reverse @$paths] if $#$paths != 0;
473 foreach my $path (@$paths) {
474 next if exists $CACHE{$path} && ! $CACHE{$path};
475 push @paths, "$path/$namespace";
479 ### make sure we have at least one path
481 croak
"Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
485 if ($directive eq 'FIRST') {
487 } elsif ($directive eq 'LAST' || $directive eq 'MERGE') {
490 croak
"Unknown directive ($directive) during write of $namespace";
493 ### remove immutable items (if any)
494 if (UNIVERSAL
::isa
($conf, 'HASH') && $conf->{"Immutable Keys"}) {
495 $conf = {%$conf}; # copy the values - only for immutable
496 my $IMMUTABLE = delete $conf->{"Immutable Keys"};
497 foreach my $key (keys %$IMMUTABLE) {
498 delete $conf->{$key};
502 ### finally write it out
503 $self->write_ref($path, $conf);
508 ###----------------------------------------------------------------###
510 sub write_handler_ini
{
513 require Config
::IniHash
;
514 return Config
::IniHash
::WriteINI
($file, $ref);
517 sub write_handler_pl
{
520 ### do has odd behavior in that it turns a simple hashref
521 ### into hash - help it out a little bit
522 require Data
::Dumper
;
523 local $Data::Dump
::Purity
= 1;
524 local $Data::Dumper
::Sortkeys
= 1;
525 local $Data::Dumper
::Quotekeys
= 0;
526 local $Data::Dumper
::Pad
= ' ';
527 local $Data::Dumper
::Varname
= 'VunderVar';
528 my $str = Data
::Dumper-
>Dumpperl([$ref]);
529 if ($str =~ s/^(.+?=\s*)//s) {
531 $str =~ s/^\s{1,$l}//mg;
533 if ($str =~ /\$VunderVar/) {
534 die "Ref to be written contained circular references - can't write";
538 open (OUT
, ">$file") || die $!;
543 sub write_handler_json
{
547 my $str = JSON
::objToJson
($ref, {pretty
=> 1, indent
=> 2});
549 open (OUT
, ">$file") || die $!;
554 sub write_handler_storable
{
558 return Storable
::store
($ref, $file);
561 sub write_handler_yaml
{
565 return YAML
::DumpFile
($file, $ref);
568 sub write_handler_xml
{
573 open (OUT
, ">$file") || die $!;
574 print OUT
scalar(XML
::Simple-
>new->XMLout($ref, noattr
=> 1));
578 sub write_handler_html
{
581 die "Write of conf information to html is not supported";
584 ###----------------------------------------------------------------###
588 my $paths = shift || $self->paths;
591 ### what extensions do we look for
593 if ($self->{handler
}) {
594 if (UNIVERSAL
::isa
($self->{handler
},'HASH')) {
595 %EXT = %{ $self->{handler
} };
599 if (! $self->{html_key
} && ! $HTML_KEY) {
600 delete $EXT{$_} foreach qw(html htm);
603 return if ! keys %EXT;
605 ### look in the paths for the files
606 foreach my $path (ref($paths) ? @$paths : $paths) {
609 next if exists $CACHE{$path};
611 my $ext = ($path =~ /\.(\w+)$/) ? $1 : '';
612 next if ! $EXT{$ext};
613 $CACHE{$path} = $self->read($path);
616 File
::Find
::find
(sub {
617 return if exists $CACHE{$File::Find
::name
};
618 return if $File::Find
::name
=~ m
|/CVS/|;
620 my $ext = (/\.(\w+)$/) ? $1 : '';
621 return if ! $EXT{$ext};
622 $CACHE{$File::Find
::name
} = $self->read($File::Find
::name
);
630 ###----------------------------------------------------------------###
638 my $cob = CGI::Ex::Conf->new;
640 my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml
641 my $hash = $cob->read($file);
643 local $cob->{default_ext} = 'conf'; # default anyway
646 my @paths = qw(/tmp, /home/pauls);
647 local $cob->{paths} = \@paths;
648 my $hash = $cob->read('My::NameSpace');
649 # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf
651 my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']});
652 # will look in /tmp/My/NameSpace.conf
655 local $cob->{directive} = 'MERGE';
656 my $hash = $cob->read('FooSpace');
658 my $hash = $cob->read('FooSpace', {directive => 'MERGE'});
659 # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf
660 # immutable keys are preserved from originating files
663 local $cob->{directive} = 'FIRST';
664 my $hash = $cob->read('FooSpace');
665 # will return values from first found file in the path.
668 local $cob->{directive} = 'LAST'; # default behavior
669 my $hash = $cob->read('FooSpace');
670 # will return values from last found file in the path.
674 $cob->write('FooSpace'); # will write it out the changes
678 There are half a million Conf readers out there. Why not add one more.
679 Actually, this module provides a wrapper around the many file formats
680 and the config modules that can handle them. It does not introduce any
683 This module also provides a preload ability which is useful in conjunction
686 Oh - and it writes too.
692 =item C<-E<gt>read_ref>
694 Takes a file and optional argument hashref. Figures out the type
695 of handler to use to read the file, reads it and returns the ref.
696 If you don't need the extended merge functionality, or key fallback,
697 or immutable keys, or path lookup ability - then use this method.
698 Otherwise - use ->read.
702 First argument may be either a perl data structure, yaml string, a
703 full filename, or a file "namespace".
705 The second argument can be a hashref of override values (referred to
708 If the first argument is a perl data structure, it will be
709 copied one level deep and returned (nested structures will contain the
710 same references). A yaml string will be parsed and returned. A full
711 filename will be read using the appropriate handler and returned (a
712 file beginning with a / or ./ or ../ is considered to be a full
713 filename). A file "namespace" (ie "footer" or "my::config" or
714 "what/ever") will be turned into a filename by looking for that
715 namespace in the paths found either in $args->{paths} or in
716 $self->{paths} or in @DEFAULT_PATHS. @DEFAULT_PATHS is empty by
717 default as is $self->{paths} - read makes no attempt to guess what
718 directories to look in. If the namespace has no extension the
719 extension listed in $args->{default_ext} or $self->{default_ext} or
720 $DEFAULT_EXT will be used).
722 my $ref = $cob->read('My::NameSpace', {
723 paths => [qw(/tmp /usr/data)],
726 # would look first for /tmp/My/NameSpace.pl
727 # and then /usr/data/My/NameSpace.pl
729 my $ref = $cob->read('foo.sto', {
730 paths => [qw(/tmp /usr/data)],
733 # would look first for /tmp/foo.sto
734 # and then /usr/data/foo.sto
736 When a namespace is used and there are multiple possible paths, there
737 area a few options to control which file to look for. A directive of
738 'FIRST', 'MERGE', or 'LAST' may be specified in $args->{directive} or
739 $self->{directive} or the default value in $DIRECTIVE will be used
740 (default is 'LAST'). When 'FIRST' is specified the first path that
741 contains the namespace is returned. If 'LAST' is used, the last
742 found path that contains the namespace is returned. If 'MERGE' is
743 used, the data structures are joined together. If they are
744 arrayrefs, they are joined into one large arrayref. If they are
745 hashes, they are layered on top of each other with keys found in later
746 paths overwriting those found in earlier paths. This allows for
747 setting system defaults in a root file, and then allow users to have
750 It is possible to make keys in a root file be immutable (non
751 overwritable) by adding a suffix of _immutable or _immu to the key (ie
752 {foo_immutable => 'bar'}). If a value is found in the file that
753 matches $IMMUTABLE_KEY, the entire file is considered immutable.
754 The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY.
756 =item C<-E<gt>write_ref>
758 Takes a file and the reference to be written. Figures out the type
759 of handler to use to write the file and writes it. If you used the ->read_ref
760 use this method. Otherwise, use ->write.
764 Allows for writing back out the information read in by ->read. If multiple
765 paths where used - the directive 'FIRST' will write the changes to the first
766 file in the path - otherwise the last path will be used. If ->read had found
767 immutable keys, then those keys are removed before writing.
769 =item C<-E<gt>preload_files>
771 Arguments are file(s) and/or directory(s) to preload. preload_files will
772 loop through the arguments, find the files that exist, read them in using
773 the handler which matches the files extension, and cache them by filename
774 in %CACHE. Directories are spidered for file extensions which match those
775 listed in %EXT_READERS. This is useful for a server environment where CPU
776 may be more precious than memory.
780 CGI::Ex::Conf supports the files found in %EXT_READERS by default.
781 Additional types may be added to %EXT_READERS, or a custom handler may be
782 passed via $args->{handler} or $self->{handler}. If the custom handler is
783 a code ref, all files will be passed to it. If it is a hashref, it should
784 contain keys which are extensions it supports, and values which read those
787 Some file types have benefits over others. Storable is very fast, but is
788 binary and not human readable. YAML is readable but very slow. I would
789 suggest using a readable format such as YAML and then using preload_files
790 to load in what you need at run time. All preloaded files are faster than
791 any of the other types.
793 The following is the list of handlers that ships with CGI::Ex::Conf (they
794 will only work if the supporting module is installed on your system):
800 Should be a file containing a perl structure which is the last thing returned.
802 =item C<sto> and C<storable>
804 Should be a file containing a structure stored in Storable format.
807 =item C<yaml> and C<conf> and C<val>
809 Should be a file containing a yaml document. Multiple documents are returned
810 as a single arrayref. Also - any file without an extension and custom handler
811 will be read using YAML. See L<YAML>.
815 Should be a windows style ini file. See L<Config::IniHash>
819 Should be an xml file. It will be read in by XMLin. See L<XML::Simple>.
821 =item C<html> and C<htm>
823 This is actually a custom type intended for use with CGI::Ex::Validate.
824 The configuration to be read is actually validation that is stored
825 inline with the html. The handler will look for any form elements or
826 input elements with an attribute with the same name as in $HTML_KEY. It
827 will also look for a javascript variable by the same name as in $HTML_KEY.
828 All configuration items done this way should be written in YAML.
829 For example, if $HTML_KEY contained 'validation' it would find validation in:
831 <input type=text name=username validation="{required: 1}">
832 # automatically indented and "username:\n" prepended
834 <form name=foo validation="
835 general no_confirm: 1
839 document.validation = "\n\
840 username: {required: 1}\n\
845 var validation = "\n\
846 username: {required: 1}\n\
850 If the key $HTML_KEY is not set, the handler will always return undef
851 without even opening the file.
857 Make a similar write method that handles immutability.
865 This module may be distributed under the same terms as Perl itself.
This page took 0.093075 seconds and 5 git commands to generate.