X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FConf.pm;h=82c76dc5dc35f9d1c658d7499f22a0b1758bc2a6;hb=3fe8e76eb82e9d74f656674c5ba913950e166ab1;hp=c1d256f64bc7c17eade4b98b86c61b4e0f03c61f;hpb=85070b46d0a93ddbeef07341421adb8389a55418;p=chaz%2Fp5-CGI-Ex

diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm
index c1d256f..82c76dc 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 2006 - 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,18 @@ use vars qw($VERSION
             $IMMUTABLE_KEY
             %CACHE
             $HTML_KEY
-            $DEBUG_ON_FAIL
+            @EXPORT_OK
             );
-use CGI::Ex::Dump qw(debug dex_warn);
+@EXPORT_OK = qw(conf_read conf_write);
 
-$VERSION = '0.03';
+$VERSION = '2.02';
 
 $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 +51,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 +79,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 +91,7 @@ sub paths {
 
 ###----------------------------------------------------------------###
 
-sub read_ref {
-  my $self = shift;
+sub conf_read {
   my $file = shift;
   my $args = shift || {};
   my $ext;
@@ -93,17 +100,21 @@ sub read_ref {
   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}) {
@@ -112,34 +123,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" };
+      warn "Conf file $file not found" if ! $args->{'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 +175,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 +189,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 +201,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 +244,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 +255,19 @@ 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 {
@@ -261,13 +276,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 +302,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 +319,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 +366,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 +377,6 @@ sub html_parse_yaml_load {
         last;
       }
     }
-    debug $err;
     die $err;
   }
   return $ref;
@@ -372,13 +384,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 +456,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 +477,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 +486,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 +504,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 +533,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 +554,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 {
@@ -580,7 +600,7 @@ sub preload_files {
     }
   }
   return if ! keys %EXT;
-  
+
   ### look in the paths for the files
   foreach my $path (ref($paths) ? @$paths : $paths) {
     $path =~ s|//+|/|g;
@@ -592,7 +612,7 @@ sub preload_files {
       $CACHE{$path} = $self->read($path);
     } elsif (-d _) {
       $CACHE{$path} = 1;
-      &File::Find::find(sub {
+      File::Find::find(sub {
         return if exists $CACHE{$File::Find::name};
         return if $File::Find::name =~ m|/CVS/|;
         return if ! -f;
@@ -612,10 +632,6 @@ sub preload_files {
 
 __END__
 
-=head1 NAME
-
-CGI::Ex::Conf - CGI Extended Conf Reader
-
 =head1 SYNOPSIS
 
   my $cob = CGI::Ex::Conf->new;
@@ -736,6 +752,8 @@ 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.
 
+Errors during read die.  If the file does not exist undef is returned.
+
 =item C<-E<gt>write_ref>
 
 Takes a file and the reference to be written.  Figures out the type
@@ -749,6 +767,8 @@ 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.
 
+Errors during write die.
+
 =item C<-E<gt>preload_files>
 
 Arguments are file(s) and/or directory(s) to preload.  preload_files will