=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
%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.00';
+$VERSION = '2.22';
$DEFAULT_EXT = 'conf';
### 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 {
open (IN, $file) || die "Couldn't open $file: $!";
CORE::read(IN, my $text, -s $file);
close IN;
+ require JSON;
return scalar JSON::jsonToObj($text);
}
$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 {
###----------------------------------------------------------------###
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;
}
###----------------------------------------------------------------###
=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
=over 4
-=item C<-E<gt>read_ref>
+=item C<read_ref>
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.
or immutable keys, or path lookup ability - then use this method.
Otherwise - use ->read.
-=item C<-E<gt>read>
+=item C<read>
First argument may be either a perl data structure, yaml string, a
full filename, or a file "namespace".
matches $IMMUTABLE_KEY, the entire file is considered immutable.
The immutable defaults may be overriden using $IMMUTABLE_QR and $IMMUTABLE_KEY.
-=item C<-E<gt>write_ref>
+Errors during read die. If the file does not exist undef is returned.
+
+=item C<write_ref>
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<-E<gt>write>
+=item C<write>
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<-E<gt>preload_files>
+Errors during write die.
+
+=item C<preload_files>
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
listed in %EXT_READERS. This is useful for a server environment where CPU
may be more precious than memory.
+=item C<in_cache>
+
+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.
Should be an xml file. It will be read in by XMLin. See L<XML::Simple>.
+=item C<json>
+
+Should be a json file. It will be read using the JSON library. See L<JSON>.
+
=item C<html> and C<htm>
This is actually a custom type intended for use with CGI::Ex::Validate.
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 <perl at seamons dot com>
+
=cut
projects / chaz / p5-CGI-Ex / blobdiff