From 57617522b5435c5b876ddf5c7d29a60c003d936c Mon Sep 17 00:00:00 2001 From: erickson Date: Wed, 16 Feb 2005 17:21:59 +0000 Subject: [PATCH] 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 --- src/perlmods/OpenSRF/Utils/SettingsClient.pm | 81 ++++++++++++++ src/perlmods/OpenSRF/Utils/SettingsParser.pm | 151 +++++++++++++++++++++++++++ 2 files changed, 232 insertions(+) create mode 100755 src/perlmods/OpenSRF/Utils/SettingsClient.pm create mode 100755 src/perlmods/OpenSRF/Utils/SettingsParser.pm diff --git a/src/perlmods/OpenSRF/Utils/SettingsClient.pm b/src/perlmods/OpenSRF/Utils/SettingsClient.pm new file mode 100755 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 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; -- 2.11.0