<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Conf;

################################################################################
#                                                                              #
# File:        shared/Conf.pm                                                  #
#                                                                              #
# Authors:     Andre Malo       &lt;nd@o3media.de&gt;, 2001-06-16                    #
#                                                                              #
# Description: read and parse configuration files                              #
#                                                                              #
################################################################################

use strict;
use vars qw(
  @EXPORT
  $VERSION
);

use XML::DOM;

################################################################################
# Version check
#
$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

################################################################################
#
# Export
#
use base qw(Exporter);
@EXPORT = qw(read_script_conf);

### add_limit () ###############################################################
#
# add limited data
#
# Params: $node   - element node
#         $conf   - hashref of config hash (will be modified)
#         $Script - scriptname (first name)
#
# Return: ~none~
#
sub add_limit ($$$) {
  my ($node, $conf, $Script) = @_;

  my %apps = map {($_ -&gt; getFirstChild -&gt; getData =&gt; 1)}
                   $node -&gt; getElementsByTagName ('Application',0) -&gt; item (0)
                   -&gt; getElementsByTagName ('Script',0);

  if ($apps {$Script}) {
    foreach ($node -&gt; getElementsByTagName ('Constant', 0)) {add_data ($_, $conf)}
    foreach ($node -&gt; getElementsByTagName ('Property', 0)) {add_prop ($_, $conf)}}

  return;
}

### add_prop () ################################################################
#
# add a property (recursive if necessary)
#
# Params: $node - element node
#         $conf - hashref of config hash (will be modified)
#
# Return: ~none~
#
sub add_prop ($$) {
  my ($node, $conf) = @_;

  my $name = $node -&gt; getAttribute ('name');

  die "element 'Property' requires attribute 'name' - aborted" unless (length ($name));

  my @props  = $node -&gt; getElementsByTagName ('Property', 0);
  my @vars = $node -&gt; getElementsByTagName ('Variable', 0);
  my @lists  = $node -&gt; getElementsByTagName ('List', 0);

  # Properties
  #
  if (@props) {
    for (@props) {
      my $hash = (defined $conf -&gt; {$name})?$conf -&gt; {$name}:{};

      die "name '$name' is defined for 'Property' and 'Variable' - aborted" unless (ref $hash eq 'HASH');

      &amp;add_prop ($_, $hash);
      $conf -&gt; {$name} = $hash;}}

  # Array
  #
  if (@lists) {
    for (@lists) {
      my $lname = $_ -&gt; getAttribute ('name');

      die "element 'List' requires attribute 'name' - aborted" unless (length ($lname) and defined ($lname));
      die "double defined name '$lname' - aborted" if ( exists ( $conf -&gt; {$name} -&gt; {$lname} ) );

      $conf -&gt; {$name} -&gt; {$lname} = [map {($_ -&gt; hasChildNodes)?$_ -&gt; getFirstChild -&gt; getData:undef} $_ -&gt; getElementsByTagName ('ListItem', 0)];}}

  # Hash
  #
  if (@vars) {
    for (@vars) {
      my $vname = $_ -&gt; getAttribute ('name');

      die "element 'Variable' requires attribute 'name' - aborted" unless (length ($vname) and defined ($vname));
      die "double defined name '$vname' - aborted" if ( exists ( $conf -&gt; {$name} -&gt; {$vname} ) );

      $conf -&gt; {$name} -&gt; {$vname} = ($_ -&gt; hasChildNodes)?$_ -&gt; getFirstChild -&gt; getData:undef;}}

  return;
}

### add_data () ################################################################
#
# add a real value (Constant or Variable)
#
# Params: $node - Element node
#         $conf - hashref of config hash (will be modified)
#
# Return: ~none~
#
sub add_data ($$) {
  my ($node, $conf) = @_;
  my $name = $node -&gt; getAttribute ('name');

  die q"element '".$node -&gt; getNodeName.q"' requires attribute 'name' - aborted" unless (length ($name) and defined ($name));
  die q"double defined name '$name' - aborted" if ( exists ( $conf -&gt; {$name} ) );

  $conf -&gt; {$name} = ($node -&gt; hasChildNodes)?$node -&gt; getFirstChild -&gt; getData:undef;

  return;
}

### parse_script_conf () #######################################################
#
# parse a config file
#
# Params: $filename - filename
#         $conf     - hashref of config hash (hash will be modified)
#         $Script   - scriptname
#
# Return: ~none~
#
sub parse_script_conf ($\%$) {
  my ($filename, $conf, $Script) = @_;

  if (-f $filename) {
    my $xml = new XML::DOM::Parser -&gt; parsefile ($filename);
    my $config = $xml -&gt; getElementsByTagName ('Config', 0) -&gt; item (0);

    add_data  $_, $conf          for ($config -&gt; getElementsByTagName ('Constant', 0));
    add_prop  $_, $conf          for ($config -&gt; getElementsByTagName ('Property', 0));
    add_limit $_, $conf, $Script for ($config -&gt; getElementsByTagName ('Limit', 0));
  }

  return;
}

### read_script_conf () ########################################################
#
# read and parse whole script config.
#
# Params: $Config - /path/to/config-dir   # NO trailing slash please
#         $Shared - /path/to/shared-dir   #        -- " --
#         $Script - scriptname
#
# Return: hashref of config hash
#
sub read_script_conf ($$$) {
  my ($Config, $Shared, $Script) = @_;

  $Script =~ s/^(.*)\..*$/$1/;             # extract script's 'first name'
  my $common  = "$Shared/common.xml";      # shared config file
  my $group   = "$Config/common.xml";      # group config file
  my $special = "$Config/$Script.xml";     # special script config file
  my %conf=();                             # config hash

  parse_script_conf ($common , %conf, $Script);
  parse_script_conf ($group,   %conf, $Script);
  parse_script_conf ($special, %conf, $Script);

  # return
  #
  \%conf;
}

# keep 'require' happy
1;

#
#
### end of Conf ################################################################

### show() #####################################################################
#
# mini data dumper
#
# Usage: Conf::Test::show (hashref)
#
package Conf::Test;sub show{print"Content-type: text/plain\n\n";&amp;hash($_[
0],'')}sub hash{my($ref,$string)=@_;foreach(sort keys%$ref){my$val=$ref-&gt;
{$_};unless(ref($val)){print$string,$_,' = ',$val,"\n";next;}else{if(ref(
$val)eq 'HASH'){&amp;hash($val,"$string$_ -&gt; ");}else{if(ref($val)eq'ARRAY'){
&amp;array($val,"$string$_ -&gt; ");}}}}}sub array {my($ref,$string)=@_;my $i=0;
foreach (@$ref){unless(ref($_)){print$string,"[$i] = ", $_,"\n";}else{if(
ref($_)eq 'HASH'){&amp;hash($_,"$string\[$i] -&gt; ")}else{if(ref($_)eq'ARRAY'){
&amp;array($_,"$string\[$i] -&gt; ");}}}$i++;}}# n.d.p./2001-01-05/lm:2001-01-19
# FUNCTION: printing the configuration, USAGE: &amp;Conf::Test::show ($conf);

#
#
### *real* end of Conf ;-) #####################################################
</pre></body></html>