package CGI::Ex::Conf;
-### CGI Extended Conf Reader
+=head1 NAME
+
+CGI::Ex::Conf - Conf Reader/Writer for many different data format types
+
+=cut
###----------------------------------------------------------------###
-# Copyright 2004 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
-### See perldoc at bottom
-
use strict;
+use base qw(Exporter);
+use Carp qw(croak);
use vars qw($VERSION
@DEFAULT_PATHS
$DEFAULT_EXT
$IMMUTABLE_KEY
%CACHE
$HTML_KEY
- $DEBUG_ON_FAIL
+ @EXPORT_OK
+ $NO_WARN_ON_FAIL
);
-use CGI::Ex::Dump qw(debug dex_warn);
+@EXPORT_OK = qw(conf_read conf_write in_cache);
-$VERSION = '0.03';
+$VERSION = '2.11';
$DEFAULT_EXT = 'conf';
%EXT_READERS = ('' => \&read_handler_yaml,
'conf' => \&read_handler_yaml,
+ 'json' => \&read_handler_json,
+ 'val_json' => \&read_handler_json,
'ini' => \&read_handler_ini,
'pl' => \&read_handler_pl,
'sto' => \&read_handler_storable,
%EXT_WRITERS = ('' => \&write_handler_yaml,
'conf' => \&write_handler_yaml,
'ini' => \&write_handler_ini,
+ 'json' => \&write_handler_json,
+ 'val_json' => \&write_handler_json,
'pl' => \&write_handler_pl,
'sto' => \&write_handler_storable,
'storable' => \&write_handler_storable,
sub new {
my $class = shift || __PACKAGE__;
- my $self = (@_ && ref($_[0])) ? shift : {@_};
+ my $args = shift || {};
- return bless $self, $class;
+ return bless {%$args}, $class;
}
sub paths {
###----------------------------------------------------------------###
-sub read_ref {
- my $self = shift;
+sub conf_read {
my $file = shift;
my $args = shift || {};
my $ext;
if (ref $file) {
if (UNIVERSAL::isa($file, 'SCALAR')) {
if ($$file =~ /^\s*</) {
- return &html_parse_yaml_load($$file, $self, $args); # allow for ref to a YAML string
+ return html_parse_yaml_load($$file, $args); # allow for ref to a YAML string
} else {
- return &yaml_load($$file); # allow for ref to a YAML string
+ return yaml_load($$file); # allow for ref to a YAML string
}
} else {
return $file;
}
+ ### allow for a pre-cached reference
+ } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
+ return $CACHE{$file};
+
### if contains a newline - treat it as a YAML string
} elsif (index($file,"\n") != -1) {
- return &yaml_load($file);
+ return yaml_load($file);
### otherwise base it off of the file extension
} elsif ($args->{file_type}) {
$ext = $1;
} else {
$ext = defined($args->{default_ext}) ? $args->{default_ext}
- : defined($self->{default_ext}) ? $self->{default_ext}
- : defined($DEFAULT_EXT) ? $DEFAULT_EXT : '';
+ : defined($DEFAULT_EXT) ? $DEFAULT_EXT
+ : '';
$file = length($ext) ? "$file.$ext" : $file;
}
- ### allow for a pre-cached reference
- if (exists $CACHE{$file} && ! $self->{no_cache}) {
- return $CACHE{$file};
- }
-
### determine the handler
- my $handler;
- if ($args->{handler}) {
- $handler = (UNIVERSAL::isa($args->{handler},'CODE'))
- ? $args->{handler} : $args->{handler}->{$ext};
- } elsif ($self->{handler}) {
- $handler = (UNIVERSAL::isa($self->{handler},'CODE'))
- ? $self->{handler} : $self->{handler}->{$ext};
- }
- if (! $handler) {
- $handler = $EXT_READERS{$ext} || die "Unknown file extension: $ext";
+ my $handler = $EXT_READERS{$ext} || croak "Unknown file extension: $ext";
+
+ ### 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'} && ! $NO_WARN_ON_FAIL;
+ return;
}
- return eval { scalar &$handler($file, $self, $args) } || do {
- debug "Couldn't read $file: $@" if $DEBUG_ON_FAIL;
- dex_warn "Couldn't read $file: $@" if ! $self->{no_warn_on_fail};
- return undef;
- };
+ return eval { scalar $handler->($file, $args) } || die "Error while reading conf file $file\n$@";
+}
+
+sub read_ref {
+ my $self = shift;
+ my $file = shift;
+ my $args = shift || {};
+ return conf_read($file, {%$self, %$args});
}
### allow for different kinds of merging of arguments
$directive = uc($args->{directive} || $self->{directive} || $DIRECTIVE);
$namespace =~ s|::|/|g; # allow perlish style namespace
my $paths = $args->{paths} || $self->paths
- || die "No paths found during read on $namespace";
+ || croak "No paths found during read on $namespace";
$paths = [$paths] if ! ref $paths;
if ($directive eq 'LAST') { # LAST shall be FIRST
$directive = 'FIRST';
### make sure we have at least one path
if ($#paths == -1) {
- die "Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
+ croak "Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
}
-
+
### now loop looking for a ref
foreach my $path (@paths) {
my $ref = $self->read_ref($path, $args) || next;
} elsif (UNIVERSAL::isa($ref, 'HASH')) {
$REF = {};
} else {
- die "Unknown config type of \"".ref($ref)."\" for namespace $namespace";
+ croak "Unknown config type of \"".ref($ref)."\" for namespace $namespace";
}
} elsif (! UNIVERSAL::isa($ref, ref($REF))) {
- die "Found different reference types for namespace $namespace"
+ croak "Found different reference types for namespace $namespace"
. " - wanted a type ".ref($REF);
}
if (ref($REF) eq 'ARRAY') {
sub read_handler_ini {
my $file = shift;
require Config::IniHash;
- return &Config::IniHash::ReadINI($file);
+ return Config::IniHash::ReadINI($file);
}
sub read_handler_pl {
return ($#ref != 0) ? {@ref} : $ref[0];
}
+sub read_handler_json {
+ my $file = shift;
+ local *IN;
+ open (IN, $file) || die "Couldn't open $file: $!";
+ CORE::read(IN, my $text, -s $file);
+ close IN;
+ return scalar JSON::jsonToObj($text);
+}
+
sub read_handler_storable {
my $file = shift;
require Storable;
- return &Storable::retrieve($file);
+ return Storable::retrieve($file);
}
sub read_handler_yaml {
open (IN, $file) || die "Couldn't open $file: $!";
CORE::read(IN, my $text, -s $file);
close IN;
- return &yaml_load($text);
+ return yaml_load($text);
}
sub yaml_load {
my $text = shift;
require YAML;
- my @ret = eval { &YAML::Load($text) };
+ my @ret = eval { YAML::Load($text) };
if ($@) {
die "$@";
}
### is specified
sub read_handler_html {
my $file = shift;
- my $self = shift;
my $args = shift;
- if (! eval {require YAML}) {
+ if (! eval { require YAML }) {
my $err = $@;
my $found = 0;
my $i = 0;
CORE::read(IN, my $html, -s $file);
close IN;
- return &html_parse_yaml_load($html, $self, $args);
+ return html_parse_yaml_load($html, $args);
}
sub html_parse_yaml_load {
my $html = shift;
- my $self = shift || {};
my $args = shift || {};
- my $key = $args->{html_key} || $self->{html_key} || $HTML_KEY;
+ my $key = $args->{html_key} || $HTML_KEY;
return undef if ! $key || $key !~ /^\w+$/;
my $str = '';
if $str && $#order != -1 && $key eq 'validation';
return undef if ! $str;
- my $ref = eval {&yaml_load($str)};
+ my $ref = eval { yaml_load($str) };
if ($@) {
my $err = "$@";
if ($err =~ /line:\s+(\d+)/) {
last;
}
}
- debug $err;
die $err;
}
return $ref;
###----------------------------------------------------------------###
+sub conf_write {
+ my $file = shift;
+ my $conf = shift || croak "Missing conf";
+ my $args = shift || {};
+ my $ext;
+
+ if (ref $file) {
+ croak "Invalid filename for write: $file";
+
+ } elsif (index($file,"\n") != -1) {
+ croak "Cannot use a yaml string as a filename during write";
+
+ ### allow for a pre-cached reference
+ } elsif (exists $CACHE{$file} && ! $args->{no_cache}) {
+ warn "Cannot write back to a file that is in the cache";
+ return 0;
+
+ ### otherwise base it off of the file extension
+ } elsif ($args->{file_type}) {
+ $ext = $args->{file_type};
+ } elsif ($file =~ /\.(\w+)$/) {
+ $ext = $1;
+ } else {
+ $ext = defined($args->{default_ext}) ? $args->{default_ext}
+ : defined($DEFAULT_EXT) ? $DEFAULT_EXT
+ : '';
+ $file = length($ext) ? "$file.$ext" : $file;
+ }
+
+ ### determine the handler
+ my $handler;
+ if ($args->{handler}) {
+ $handler = (UNIVERSAL::isa($args->{handler},'CODE'))
+ ? $args->{handler} : $args->{handler}->{$ext};
+ }
+ if (! $handler) {
+ $handler = $EXT_WRITERS{$ext} || croak "Unknown file extension: $ext";
+ }
+
+ return eval { scalar $handler->($file, $conf, $args) } || die "Error while writing conf file $file\n$@";
+}
+
+sub write_ref {
+ my $self = shift;
+ my $file = shift;
+ my $conf = shift;
+ my $args = shift || {};
+ conf_write($file, $conf, {%$self, %$args});
+}
+
### Allow for writing out conf values
### Allow for writing out the correct filename (if there is a path array)
### Allow for not writing out immutable values on hashes
sub write {
my $self = shift;
my $namespace = shift;
- my $conf = shift || die "Must pass hashref to write out"; # the info to write
+ my $conf = shift || croak "Must pass hashref to write out"; # the info to write
my $args = shift || {};
my $IMMUTABLE = $args->{immutable} || {}; # can pass existing immutable types
$directive = 'FIRST';
} elsif (index($namespace,"\n") != -1) { # yaml string - can't write that
- die "Cannot use a yaml string as a namespace for write";
+ croak "Cannot use a yaml string as a namespace for write";
### use the default directories
} else {
$directive = uc($args->{directive} || $self->{directive} || $DIRECTIVE);
$namespace =~ s|::|/|g; # allow perlish style namespace
my $paths = $args->{paths} || $self->paths
- || die "No paths found during write on $namespace";
+ || croak "No paths found during write on $namespace";
$paths = [$paths] if ! ref $paths;
if ($directive eq 'LAST') { # LAST shall be FIRST
$directive = 'FIRST';
### make sure we have at least one path
if ($#paths == -1) {
- die "Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
+ croak "Couldn't find a path for namespace $namespace. Perhaps you need to pass paths => \@paths";
}
my $path;
} elsif ($directive eq 'LAST' || $directive eq 'MERGE') {
$path = $paths[-1];
} else {
- die "Unknown directive ($directive) during write of $namespace";
+ croak "Unknown directive ($directive) during write of $namespace";
}
### remove immutable items (if any)
return 1;
}
-sub write_ref {
- my $self = shift;
- my $file = shift;
- my $conf = shift || die "Missing conf";
- my $args = shift || {};
- my $ext;
-
- if (ref $file) {
- die "Invalid filename for write: $file";
-
- } elsif (index($file,"\n") != -1) {
- die "Cannot use a yaml string as a filename during write";
-
- ### otherwise base it off of the file extension
- } elsif ($args->{file_type}) {
- $ext = $args->{file_type};
- } elsif ($file =~ /\.(\w+)$/) {
- $ext = $1;
- } else {
- $ext = defined($args->{default_ext}) ? $args->{default_ext}
- : defined($self->{default_ext}) ? $self->{default_ext}
- : defined($DEFAULT_EXT) ? $DEFAULT_EXT : '';
- $file = length($ext) ? "$file.$ext" : $file;
- }
-
- ### allow for a pre-cached reference
- if (exists $CACHE{$file} && ! $self->{no_cache}) {
- warn "Cannot write back to a file that is in the cache";
- return 0;
- }
-
- ### determine the handler
- my $handler;
- if ($args->{handler}) {
- $handler = (UNIVERSAL::isa($args->{handler},'CODE'))
- ? $args->{handler} : $args->{handler}->{$ext};
- } elsif ($self->{handler}) {
- $handler = (UNIVERSAL::isa($self->{handler},'CODE'))
- ? $self->{handler} : $self->{handler}->{$ext};
- }
- if (! $handler) {
- $handler = $EXT_WRITERS{$ext} || die "Unknown file extension: $ext";
- }
-
- return eval { scalar &$handler($file, $conf, $args) } || do {
- debug "Couldn't write $file: $@" if $DEBUG_ON_FAIL;
- dex_warn "Couldn't write $file: $@" if ! $self->{no_warn_on_fail};
- return 0;
- };
-
- return 1;
-}
-
###----------------------------------------------------------------###
sub write_handler_ini {
my $file = shift;
my $ref = shift;
require Config::IniHash;
- return &Config::IniHash::WriteINI($file, $ref);
+ return Config::IniHash::WriteINI($file, $ref);
}
sub write_handler_pl {
die "Ref to be written contained circular references - can't write";
}
+ local *OUT;
+ open (OUT, ">$file") || die $!;
+ print OUT $str;
+ close OUT;
+}
+
+sub write_handler_json {
+ my $file = shift;
+ my $ref = shift;
+ require JSON;
+ my $str = JSON::objToJson($ref, {pretty => 1, indent => 2});
local *OUT;
open (OUT, ">$file") || die $!;
print OUT $str;
my $file = shift;
my $ref = shift;
require Storable;
- return &Storable::store($ref, $file);
+ return Storable::store($ref, $file);
}
sub write_handler_yaml {
my $file = shift;
my $ref = shift;
require YAML;
- &YAML::DumpFile($file, $ref);
+ return YAML::DumpFile($file, $ref);
}
sub write_handler_xml {
###----------------------------------------------------------------###
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;
}
###----------------------------------------------------------------###
__END__
-=head1 NAME
+=head1 SYNOPSIS
-CGI::Ex::Conf - CGI Extended Conf Reader
+ use CGI::Ex::Conf qw(conf_read conf_write);
-=head1 SYNOPSIS
+ my $hash = conf_read("/tmp/foo.yaml");
- my $cob = CGI::Ex::Conf->new;
+ 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.
projects / chaz / p5-CGI-Ex / blobdiff