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