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=c1d256f64bc7c17eade4b98b86c61b4e0f03c61f;hb=ed00221d27dfab1e82ec2ea040ab4c399a91c545;hpb=85070b46d0a93ddbeef07341421adb8389a55418 diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index c1d256f..1288e7b 100644 --- a/lib/CGI/Ex/Conf.pm +++ b/lib/CGI/Ex/Conf.pm @@ -1,15 +1,19 @@ 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 @@ -20,16 +24,19 @@ use vars qw($VERSION $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.24'; $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, @@ -45,6 +52,8 @@ $DEFAULT_EXT = 'conf'; %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, @@ -71,9 +80,9 @@ $IMMUTABLE_KEY = 'immutable'; sub new { my $class = shift || __PACKAGE__; - my $self = (@_ && ref($_[0])) ? shift : {@_}; + my $args = shift || {}; - return bless $self, $class; + return bless {%$args}, $class; } sub paths { @@ -83,8 +92,7 @@ sub paths { ###----------------------------------------------------------------### -sub read_ref { - my $self = shift; +sub conf_read { my $file = shift; my $args = shift || {}; my $ext; @@ -93,17 +101,21 @@ sub read_ref { if (ref $file) { if (UNIVERSAL::isa($file, 'SCALAR')) { if ($$file =~ /^\s*{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}) { @@ -112,34 +124,29 @@ sub read_ref { $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\n" }; + 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 @@ -169,7 +176,7 @@ sub read { $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'; @@ -183,9 +190,9 @@ sub read { ### 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; @@ -195,10 +202,10 @@ sub read { } 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') { @@ -238,7 +245,7 @@ sub read { sub read_handler_ini { my $file = shift; require Config::IniHash; - return &Config::IniHash::ReadINI($file); + return Config::IniHash::ReadINI($file); } sub read_handler_pl { @@ -249,10 +256,20 @@ 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; + require JSON; + 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 { @@ -261,13 +278,13 @@ 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 "$@"; } @@ -287,9 +304,8 @@ sub read_handler_xml { ### 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; @@ -305,14 +321,13 @@ sub read_handler_html { 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 = ''; @@ -353,7 +368,7 @@ sub html_parse_yaml_load { 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+)/) { @@ -364,7 +379,6 @@ sub html_parse_yaml_load { last; } } - debug $err; die $err; } return $ref; @@ -372,13 +386,63 @@ sub html_parse_yaml_load { ###----------------------------------------------------------------### +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 @@ -394,14 +458,14 @@ sub write { $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'; @@ -415,7 +479,7 @@ sub write { ### 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; @@ -424,7 +488,7 @@ sub write { } 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) @@ -442,66 +506,13 @@ sub write { 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 { @@ -524,6 +535,17 @@ 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; @@ -534,14 +556,14 @@ sub write_handler_storable { 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 { @@ -563,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; } ###----------------------------------------------------------------### @@ -612,49 +639,55 @@ sub preload_files { __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 @@ -672,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. @@ -680,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". @@ -736,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 @@ -758,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. @@ -801,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. @@ -839,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