Beginnings of the new config parsing and client classes

git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@71 9efc2488-bf62-4759-914b-345cdb29e865

diff --git a/src/perlmods/OpenSRF/Utils/SettingsClient.pm b/src/perlmods/OpenSRF/Utils/SettingsClient.pm
new file mode 100755 (executable)
index 0000000..6a4365d
--- /dev/null
+++ b/src/perlmods/OpenSRF/Utils/SettingsClient.pm
@@ -0,0 +1,81 @@
+package OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::SettingsParser;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use OpenSRF::Utils::Config;
+use OpenSRF::EX qw(:try);
+
+use vars qw/$host_config/;
+
+
+sub new {return bless({},shift());}
+my $session;
+$host_config = undef;
+
+# ------------------------------------
+# utility method for grabbing config info
+sub config_value {
+       my($self,@keys) = @_;
+
+       if(!$host_config) { grab_host_config($host); }
+       if(!$host_config) {
+               throw OpenSRF::EX::Config ("Unable to retrieve host config for $host" );
+       }
+
+       my $hash = $host_config;
+
+       # XXX TO DO, check local config 'version', 
+       # call out to settings server when necessary....
+       try {
+               for my $key (@keys) {
+                       $hash = $hash->{$key};
+               }
+
+       } catch Error with {
+               my $e = shift;
+               throw OpenSRF::EX::Config ("No Config information for @keys : $e : $@");
+       };
+
+       return $hash;
+
+}
+
+
+# XXX make smarter and more robust...
+sub grab_host_config {
+
+       my $host = shift;
+
+       OpenSRF::System::bootstrap_client("system_client");
+       $session = OpenSRF::AppSession->create( "settings" ) unless $session;
+       my $bsconfig = OpenSRF::Utils::Config->current;
+
+       my $resp;
+       try {
+
+               if( ! ($session->connect()) ) {die "Settings Connect timed out\n";}
+               my $req = $session->request( "opensrf.settings.host_config.get", $host );
+               $resp = $req->recv( timeout => 10 );
+
+       } catch OpenSRF::EX with {
+
+               my $e = shift;
+               warn "Connection to Settings Failed  $e : $@ ***\n";
+               die $e;
+       };
+
+       if(!$resp) {
+               warn "No Response from settings server...going to sleep\n";
+               sleep;
+       }
+
+       if( $resp && UNIVERSAL::isa( $resp, "OpenSRF::EX" ) ) {
+               throw $resp;
+       }
+
+       $host_config = $resp->content();
+}
+
+
+
+1;

diff --git a/src/perlmods/OpenSRF/Utils/SettingsParser.pm b/src/perlmods/OpenSRF/Utils/SettingsParser.pm
new file mode 100755 (executable)
index 0000000..9777626
--- /dev/null
+++ b/src/perlmods/OpenSRF/Utils/SettingsParser.pm
@@ -0,0 +1,151 @@
+use strict; use warnings;
+package OpenSRF::Utils::SettingsParser;
+use OpenSRF::Utils::Config;
+use OpenSRF::EX qw(:try);
+
+
+
+use XML::LibXML;
+
+sub DESTROY{}
+our $log = 'OpenSRF::Utils::Logger';
+my $parser;
+my $doc;
+
+sub new { return bless({},shift()); }
+
+
+# returns 0 if the config file could not be found or if there is a parse error
+# returns 1 if successful
+sub initialize {
+
+       my ($self,$bootstrap_config) = @_;
+       return 0 unless($self and $bootstrap_config);
+
+       $parser = XML::LibXML->new();
+       $parser->keep_blanks(0);
+       try {
+               $doc = $parser->parse_file( $bootstrap_config );
+       } catch Error with {
+               return 0;
+       };
+       return 1;
+}
+
+sub _get { _get_overlay(@_) }
+
+sub _get_overlay {
+       my( $self, $xpath ) = @_;
+       my @nodes = $doc->documentElement->findnodes( $xpath );
+       
+       my $base = XML2perl(shift(@nodes));
+       my @overlays;
+       for my $node (@nodes) {
+               push @overlays, XML2perl($node);
+       }
+
+       for my $ol ( @overlays ) {
+               $base = merge_perl($base, $ol);
+       }
+       
+       return $base;
+}
+
+sub _get_all {
+       my( $self, $xpath ) = @_;
+       my @nodes = $doc->documentElement->findnodes( $xpath );
+       
+       my @overlays;
+       for my $node (@nodes) {
+               push @overlays, XML2perl($node);
+       }
+
+       return \@overlays;
+}
+
+sub merge_perl {
+       my $base = shift;
+       my $ol = shift;
+
+       if (ref($ol)) {
+               if (ref($ol) eq 'HASH') {
+                       for my $key (keys %$ol) {
+                               if (ref($$ol{$key}) and ref($$ol{$key}) eq ref($$base{$key})) {
+                                       merge_perl($$base{$key}, $$ol{$key});
+                               } else {
+                                       $$base{$key} = $$ol{$key};
+                               }
+                       }
+               } else {
+                       for my $key (0 .. scalar(@$ol) - 1) {
+                               if (ref($$ol[$key]) and ref($$ol[$key]) eq ref($$base[$key])) {
+                                       merge_perl($$base[$key], $$ol[$key]);
+                               } else {
+                                       $$base[$key] = $$ol[$key];
+                               }
+                       }
+               }
+       } else {
+               $base = $ol;
+       }
+
+       return $base;
+}
+
+
+sub XML2perl {
+       my $node = shift;
+       my %output;
+
+       return undef unless($node);
+
+       for my $attr ( ($node->attributes()) ) {
+               next unless($attr);
+               $output{$attr->nodeName} = $attr->value;
+       }
+
+       my @kids = $node->childNodes;
+       if (@kids == 1 && $kids[0]->nodeType == 3) {
+                       return $kids[0]->textContent;
+       } else {
+               for my $kid ( @kids ) {
+                       next if ($kid->nodeName eq 'comment');
+                       if (exists $output{$kid->nodeName}) {
+                               if (ref $output{$kid->nodeName} ne 'ARRAY') {
+                                       $output{$kid->nodeName} = [$output{$kid->nodeName}, XML2perl($kid)];
+                               } else {
+                                       push @{$output{$kid->nodeName}}, XML2perl($kid);
+                               }
+                               next;
+                       }
+                       $output{$kid->nodeName} = XML2perl($kid);
+               }
+       }
+
+       return \%output;
+}
+
+
+# returns the full config hash for a given server
+sub get_server_config {
+       my( $self, $server ) = @_;
+       my $xpath = "/opensrf/default|/opensrf/hosts/$server";
+       return $self->_get( $xpath );
+}
+
+sub get_bootstrap_config {
+       my( $self ) = @_;
+       my $xpath = "/opensrf/bootstrap";
+       return $self->_get( $xpath );
+}
+
+sub get_router_config {
+       my( $self, $router ) = @_;
+       my $xpath = "/opensrf/routers/$router";
+       return $self->_get($xpath );
+}
+
+
+
+
+1;