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

# ====================================================
# Autor: n.d.p. / 2001-01-05
# lm   : n.d.p. / 2001-02-02
# ====================================================
# Funktion:
#      Einlesen der Scriptkonfiguration
# ====================================================

use strict;

package Conf;

use XML::DOM;

# ====================================================
# Funktionsexport
# ====================================================

use base qw(Exporter);
@Conf::EXPORT = qw(read_script_conf);

################################
# sub read_script_conf
#
# Scriptkonf. lesen
################################

sub read_script_conf ($$$) {
  my ($Config, $Shared, $Script) = @_;

  $Script =~ s/^(.*)\..*$/$1/;             # Vornamen extrahieren
  my $common  = "$Shared/common.xml";      # gemeinsame Konf-datei
  my $group   = "$Config/common.xml";  # gemeinsame (Gruppen-)Konf-datei
  my $special = "$Config/$Script.xml"; # spezielle Konf-datei
  my %conf=();                             # conf-Hash

  &amp;parse_script_conf ($common , \%conf, $Script);   # und los...
  &amp;parse_script_conf ($group,   \%conf, $Script);
  &amp;parse_script_conf ($special, \%conf, $Script);

  # Rueckgabe
  \%conf;
}

# ====================================================
# Private Funktionen
# ====================================================

sub parse_script_conf ($$$) {
  my ($filename, $conf, $Script) = @_;

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

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

  return;
}

sub add_data ($$) {
  my ($node, $conf) = @_;
  my $name = $node -&gt; getAttribute ('name');

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

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

  return;
}

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;
}

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)) {&amp;add_data ($_, $conf)}
    foreach ($node -&gt; getElementsByTagName ('Property', 0)) {&amp;add_prop ($_, $conf)}}

  return;
}

# ====================================================
# Modulinitialisierung
# ====================================================

# making require happy
1;

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

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>