X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=lib%2FCGI%2FEx%2FConf.pm;h=365ece2d057b1fbd4640364a1502aea478e5e6d0;hp=787be6fb2f41cba4d4a7d991cd057a042aa936e7;hb=490b94ab4051adf93abf16a4ed34efb923d6e8fc;hpb=d2b7c937e86e6e8c4b4193e9f4a8da075919b4fd diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index 787be6f..365ece2 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.03'; +$VERSION = '2.22'; $DEFAULT_EXT = 'conf'; @@ -133,8 +134,8 @@ sub conf_read { ### don't die if the file is not found - do die otherwise if (! -e $file) { - eval { die "Conf file $file not found" }; - warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'}; + 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; } @@ -261,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); } @@ -583,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; } ###----------------------------------------------------------------### @@ -634,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}); + + + ### OOP interface - my $full_path_to_file = "/tmp/foo.val"; # supports ini, sto, val, pl, xml - my $hash = $cob->read($file); + my $cob = CGI::Ex::Conf->new; - local $cob->{default_ext} = 'conf'; # default anyway + 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 - 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 $hash = $cob->read('My::NameSpace', {paths => ['/tmp']}); - # will look in /tmp/My/NameSpace.conf + 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} = '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 $hash = $cob->read('My::NameSpace', {paths => ['/tmp']}); + # will look in /tmp/My/NameSpace.conf - local $cob->{directive} = 'FIRST'; - my $hash = $cob->read('FooSpace'); - # will return values from first 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 - local $cob->{directive} = 'LAST'; # default behavior - my $hash = $cob->read('FooSpace'); - # will return values from last found file in the path. + local $cob->{directive} = 'FIRST'; + my $hash = $cob->read('FooSpace'); + # will return values from first found file in the path. - ### manipulate $hash - $cob->write('FooSpace'); # will write it out the changes + 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 @@ -688,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. @@ -696,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". @@ -754,13 +771,13 @@ The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY. Errors during read die. If the file does not exist undef is returned. -=item C<-Ewrite_ref> +=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 @@ -769,7 +786,7 @@ immutable keys, then those keys are removed before writing. Errors during write die. -=item C<-Epreload_files> +=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 @@ -778,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. @@ -821,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. @@ -859,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