1 use strict; use warnings;
2 package OpenSRF::Utils::SettingsParser;
3 use OpenSRF::Utils::Config;
4 use OpenSRF::EX qw(:try);
5 use OpenSRF::Utils::Logger;
8 # logger is not yet exported when this mod is loaded
9 my $logger = 'OpenSRF::Utils::Logger';
13 my $settings_file; # /path/to/opensrf.xml
15 sub new { return bless({},shift()); }
17 # reload the configuration file
20 $logger->info("settings parser reloading '$settings_file'");
25 # returns 0 if the config file could not be found or if there is a parse error
26 # returns 1 if successful
28 my ($self, $filename) = @_;
30 $settings_file = $filename if $filename;
31 return 0 unless $settings_file;
33 my $parser = XML::LibXML->new();
34 $parser->keep_blanks(0);
38 $doc = $parser->parse_file( $settings_file );
41 $logger->error("Error parsing $settings_file : $err");
47 sub _get { _get_overlay(@_) }
50 my( $self, $xpath ) = @_;
51 my @nodes = $doc->documentElement->findnodes( $xpath );
53 my $base = XML2perl(shift(@nodes));
55 for my $node (@nodes) {
56 push @overlays, XML2perl($node);
59 for my $ol ( @overlays ) {
60 $base = merge_perl($base, $ol);
67 my( $self, $xpath ) = @_;
68 my @nodes = $doc->documentElement->findnodes( $xpath );
71 for my $node (@nodes) {
72 push @overlays, XML2perl($node);
83 if (ref($ol) eq 'HASH') {
84 for my $key (keys %$ol) {
85 if (ref($$ol{$key}) and ref($$ol{$key}) eq ref($$base{$key})) {
86 merge_perl($$base{$key}, $$ol{$key});
88 $$base{$key} = $$ol{$key};
92 for my $key (0 .. scalar(@$ol) - 1) {
93 if (ref($$ol[$key]) and ref($$ol[$key]) eq ref($$base[$key])) {
94 merge_perl($$base[$key], $$ol[$key]);
96 $$base[$key] = $$ol[$key];
109 return 0+$value if ($value =~ /^\d{1,10}$/o);
117 return undef unless($node);
119 for my $attr ( ($node->attributes()) ) {
121 $output{$attr->nodeName} = _check_for_int($attr->value);
124 my @kids = $node->childNodes;
125 if (@kids == 1 && $kids[0]->nodeType == 3) {
126 return _check_for_int($kids[0]->textContent);
128 for my $kid ( @kids ) {
129 next if ($kid->nodeName eq 'comment');
130 if (exists $output{$kid->nodeName}) {
131 if (ref $output{$kid->nodeName} ne 'ARRAY') {
132 $output{$kid->nodeName} = [$output{$kid->nodeName}, XML2perl($kid)];
134 push @{$output{$kid->nodeName}}, XML2perl($kid);
138 $output{$kid->nodeName} = XML2perl($kid);
146 # returns the full config hash for a given server
147 sub get_server_config {
148 my( $self, $server ) = @_;
150 # Work around a Net::Domain bug that can result in fqdn like foo.example.com,bar.com
151 my @servers = split /,/, $server;
152 my $xpath = "/opensrf/default";
154 $xpath .= "|/opensrf/hosts/$_";
156 return $self->_get( $xpath );
159 sub get_default_config {
160 my( $self, $server ) = @_;
161 my $xpath = "/opensrf/default";
162 return $self->_get( $xpath );