X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=lib%2FCGI%2FEx%2FConf.pm;h=1288e7b735a1f30fb37880a32c4f31f66bd230f6;hp=5bcedfd9356b8c870a4074e0560eb25bce198c83;hb=ed00221d27dfab1e82ec2ea040ab4c399a91c545;hpb=a8620142ba0dcda3f0c5f102f791df944ed2245e diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index 5bcedfd..1288e7b 100644 --- a/lib/CGI/Ex/Conf.pm +++ b/lib/CGI/Ex/Conf.pm @@ -7,7 +7,7 @@ CGI::Ex::Conf - Conf Reader/Writer for many different data format types =cut ###----------------------------------------------------------------### -# Copyright 2006 - Paul Seamons # +# Copyright 2007 - Paul Seamons # # Distributed under the Perl Artistic License without warranty # ###----------------------------------------------------------------### @@ -25,10 +25,11 @@ use vars qw($VERSION %CACHE $HTML_KEY @EXPORT_OK + $NO_WARN_ON_FAIL ); -@EXPORT_OK = qw(conf_read conf_write); +@EXPORT_OK = qw(conf_read conf_write in_cache); -$VERSION = '2.01'; +$VERSION = '2.24'; $DEFAULT_EXT = 'conf'; @@ -131,10 +132,14 @@ sub conf_read { ### determine the handler my $handler = $EXT_READERS{$ext} || croak "Unknown file extension: $ext"; - return eval { scalar $handler->($file, $args) } || do { - warn "Couldn't read $file: $@ " if ! $args->{no_warn_on_fail}; - return undef; - }; + ### don't die if the file is not found - do die otherwise + if (! -e $file) { + eval { die "Conf file $file not found\n" }; + warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'} && ! $NO_WARN_ON_FAIL; + return; + } + + return eval { scalar $handler->($file, $args) } || die "Error while reading conf file $file\n$@"; } sub read_ref { @@ -257,6 +262,7 @@ sub read_handler_json { open (IN, $file) || die "Couldn't open $file: $!"; CORE::read(IN, my $text, -s $file); close IN; + require JSON; return scalar JSON::jsonToObj($text); } @@ -419,12 +425,7 @@ sub conf_write { $handler = $EXT_WRITERS{$ext} || croak "Unknown file extension: $ext"; } - return eval { scalar $handler->($file, $conf, $args) } || do { - warn "Couldn't write $file: $@ " if ! $args->{no_warn_on_fail}; - return 0; - }; - - return 1; + return eval { scalar $handler->($file, $conf, $args) } || die "Error while writing conf file $file\n$@"; } sub write_ref { @@ -584,47 +585,52 @@ sub write_handler_html { ###----------------------------------------------------------------### sub preload_files { - my $self = shift; - my $paths = shift || $self->paths; - require File::Find; - - ### what extensions do we look for - my %EXT; - if ($self->{handler}) { - if (UNIVERSAL::isa($self->{handler},'HASH')) { - %EXT = %{ $self->{handler} }; - } - } else { - %EXT = %EXT_READERS; - if (! $self->{html_key} && ! $HTML_KEY) { - delete $EXT{$_} foreach qw(html htm); - } - } - return if ! keys %EXT; - - ### look in the paths for the files - foreach my $path (ref($paths) ? @$paths : $paths) { - $path =~ s|//+|/|g; - $path =~ s|/$||; - next if exists $CACHE{$path}; - if (-f $path) { - my $ext = ($path =~ /\.(\w+)$/) ? $1 : ''; - next if ! $EXT{$ext}; - $CACHE{$path} = $self->read($path); - } elsif (-d _) { - $CACHE{$path} = 1; - File::Find::find(sub { - return if exists $CACHE{$File::Find::name}; - return if $File::Find::name =~ m|/CVS/|; - return if ! -f; - my $ext = (/\.(\w+)$/) ? $1 : ''; - return if ! $EXT{$ext}; - $CACHE{$File::Find::name} = $self->read($File::Find::name); - }, "$path/"); + my $self = shift; + my $paths = shift || $self->paths; + + ### what extensions do we look for + my %EXT; + if ($self->{'handler'}) { + if (UNIVERSAL::isa($self->{'handler'},'HASH')) { + %EXT = %{ $self->{'handler'} }; + } } else { - $CACHE{$path} = 0; + %EXT = %EXT_READERS; + if (! $self->{'html_key'} && ! $HTML_KEY) { + delete $EXT{$_} foreach qw(html htm); + } } - } + return if ! keys %EXT; + + ### look in the paths for the files + foreach my $path (ref($paths) ? @$paths : $paths) { + $path =~ s|//+|/|g; + $path =~ s|/$||; + next if exists $CACHE{$path}; + if (-f $path) { + my $ext = ($path =~ /\.(\w+)$/) ? $1 : ''; + next if ! $EXT{$ext}; + $CACHE{$path} = $self->read($path); + } elsif (-d _) { + $CACHE{$path} = 1; + require File::Find; + File::Find::find(sub { + return if exists $CACHE{$File::Find::name}; + return if $File::Find::name =~ m|/CVS/|; + return if ! -f; + my $ext = (/\.(\w+)$/) ? $1 : ''; + return if ! $EXT{$ext}; + $CACHE{$File::Find::name} = $self->read($File::Find::name); + }, "$path/"); + } else { + $CACHE{$path} = 0; + } + } +} + +sub in_cache { + my ($self, $file) = (@_ == 2) ? @_ : (undef, shift()); + return exists($CACHE{$file}) || 0; } ###----------------------------------------------------------------### @@ -635,43 +641,53 @@ __END__ =head1 SYNOPSIS - my $cob = CGI::Ex::Conf->new; + use CGI::Ex::Conf qw(conf_read conf_write); + + my $hash = conf_read("/tmp/foo.yaml"); + + conf_write("/tmp/foo.yaml", {key1 => $val1, key2 => $val2}); - my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml - my $hash = $cob->read($file); - local $cob->{default_ext} = 'conf'; # default anyway + ### OOP interface + my $cob = CGI::Ex::Conf->new; - my @paths = qw(/tmp, /home/pauls); - local $cob->{paths} = \@paths; - my $hash = $cob->read('My::NameSpace'); - # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf + my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml + my $hash = $cob->read($file); - my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']}); - # will look in /tmp/My/NameSpace.conf + local $cob->{default_ext} = 'conf'; # default anyway - local $cob->{directive} = 'MERGE'; - my $hash = $cob->read('FooSpace'); - # OR # - my $hash = $cob->read('FooSpace', {directive => 'MERGE'}); - # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf - # immutable keys are preserved from originating files + my @paths = qw(/tmp, /home/pauls); + local $cob->{paths} = \@paths; + my $hash = $cob->read('My::NameSpace'); + # will look in /tmp/My/NameSpace.conf and /home/pauls/My/NameSpace.conf - local $cob->{directive} = 'FIRST'; - my $hash = $cob->read('FooSpace'); - # will return values from first found file in the path. + my $hash = $cob->read('My::NameSpace', {paths => ['/tmp']}); + # will look in /tmp/My/NameSpace.conf - local $cob->{directive} = 'LAST'; # default behavior - my $hash = $cob->read('FooSpace'); - # will return values from last found file in the path. + local $cob->{directive} = 'MERGE'; + my $hash = $cob->read('FooSpace'); + # OR # + my $hash = $cob->read('FooSpace', {directive => 'MERGE'}); + # will return merged hashes from /tmp/FooSpace.conf and /home/pauls/FooSpace.conf + # immutable keys are preserved from originating files - ### manipulate $hash - $cob->write('FooSpace'); # will write it out the changes + local $cob->{directive} = 'FIRST'; + my $hash = $cob->read('FooSpace'); + # will return values from first found file in the path. + + + local $cob->{directive} = 'LAST'; # default behavior + my $hash = $cob->read('FooSpace'); + # will return values from last found file in the path. + + + ### manipulate $hash + $cob->write('FooSpace'); # will write it out the changes =head1 DESCRIPTION @@ -689,7 +705,7 @@ Oh - and it writes too. =over 4 -=item C<-Eread_ref> +=item C Takes a file and optional argument hashref. Figures out the type of handler to use to read the file, reads it and returns the ref. @@ -697,7 +713,7 @@ If you don't need the extended merge functionality, or key fallback, or immutable keys, or path lookup ability - then use this method. Otherwise - use ->read. -=item C<-Eread> +=item C First argument may be either a perl data structure, yaml string, a full filename, or a file "namespace". @@ -753,20 +769,24 @@ overwritable) by adding a suffix of _immutable or _immu to the key (ie matches $IMMUTABLE_KEY, the entire file is considered immutable. The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY. -=item C<-Ewrite_ref> +Errors during read die. If the file does not exist undef is returned. + +=item C Takes a file and the reference to be written. Figures out the type of handler to use to write the file and writes it. If you used the ->read_ref use this method. Otherwise, use ->write. -=item C<-Ewrite> +=item C Allows for writing back out the information read in by ->read. If multiple paths where used - the directive 'FIRST' will write the changes to the first file in the path - otherwise the last path will be used. If ->read had found immutable keys, then those keys are removed before writing. -=item C<-Epreload_files> +Errors during write die. + +=item C Arguments are file(s) and/or directory(s) to preload. preload_files will loop through the arguments, find the files that exist, read them in using @@ -775,6 +795,36 @@ in %CACHE. Directories are spidered for file extensions which match those listed in %EXT_READERS. This is useful for a server environment where CPU may be more precious than memory. +=item C + +Allow for testing if a particular filename is registered in the %CACHE - typically +from a preload_files call. This is useful when building wrappers around the +conf_read and conf_write method calls. + +=back + +=head1 FUNCTIONS + +=over 4 + +=item conf_read + +Takes a filename. Returns the read contents of that filename. The handler +to use is based upon the extention on the file. + + my $hash = conf_read('/tmp/foo.yaml'); + + my $hash = conf_read('/tmp/foo', {file_type => 'yaml'}); + +Takes a filename and a data structure. Writes the data to the filename. The handler +to use is based upon the extention on the file. + + conf_write('/tmp/foo.yaml', \%hash); + + conf_write('/tmp/foo', \%hash, {file_type => 'yaml'}); + +=back + =head1 FILETYPES CGI::Ex::Conf supports the files found in %EXT_READERS by default. @@ -818,6 +868,10 @@ Should be a windows style ini file. See L Should be an xml file. It will be read in by XMLin. See L. +=item C + +Should be a json file. It will be read using the JSON library. See L. + =item C and C This is actually a custom type intended for use with CGI::Ex::Validate. @@ -856,13 +910,13 @@ without even opening the file. Make a similar write method that handles immutability. -=head1 AUTHOR - -Paul Seamons - =head1 LICENSE This module may be distributed under the same terms as Perl itself. +=head1 AUTHOR + +Paul Seamons + =cut