selfforum-cgi/shared/Conf.pm

   1 # Conf.pm
   2
   3 # ====================================================
   4 # Autor: n.d.p. / 2001-01-05
   5 # lm   : n.d.p. / 2001-02-02
   6 # ====================================================
   7 # Funktion:
   8 #      Einlesen der Scriptkonfiguration
   9 # ====================================================
  10
  11 use strict;
  12
  13 package Conf;
  14
  15 use XML::DOM;
  16
  17 # ====================================================
  18 # Funktionsexport
  19 # ====================================================
  20
  21 use base qw(Exporter);
  22 @Conf::EXPORT = qw(read_script_conf);
  23
  24 ################################
  25 # sub read_script_conf
  26 #
  27 # Scriptkonf. lesen
  28 ################################
  29
  30 sub read_script_conf ($$$) {
  31   my ($Bin, $Shared, $Script) = @_;
  32
  33   $Script =~ s/^(.*)\..*$/$1/;             # Vornamen extrahieren
  34   my $common  = "$Shared/common.xml";      # gemeinsame Konf-datei
  35   my $group   = "$Bin/config/common.xml";  # gemeinsame (Gruppen-)Konf-datei
  36   my $special = "$Bin/config/$Script.xml"; # spezielle Konf-datei
  37   my %conf=();                             # conf-Hash
  38
  39   &parse_script_conf ($common , \%conf, $Script);   # und los...
  40   &parse_script_conf ($group,   \%conf, $Script);
  41   &parse_script_conf ($special, \%conf, $Script);
  42
  43   # Rueckgabe
  44   \%conf;
  45 }
  46
  47 # ====================================================
  48 # Private Funktionen
  49 # ====================================================
  50
  51 sub parse_script_conf ($$$) {
  52   my ($filename, $conf, $Script) = @_;
  53
  54   if (-f $filename) {
  55     # XML parsen
  56     my $xml = new XML::DOM::Parser -> parsefile ($filename);
  57     my $config = $xml -> getElementsByTagName ('Config',0) -> item (0);
  58
  59     foreach ($config -> getElementsByTagName ('Constant', 0)) {&add_data ($_, $conf)}
  60     foreach ($config -> getElementsByTagName ('Property', 0)) {&add_prop ($_, $conf)}
  61     foreach ($config -> getElementsByTagName ('Limit', 0))    {&add_limit ($_, $conf, $Script)}}
  62
  63   return;
  64 }
  65
  66 sub add_data ($$) {
  67   my ($node, $conf) = @_;
  68   my $name = $node -> getAttribute ('name');
  69
  70   die "element '".$node -> getNodeName."' requires attribute 'name' - aborted" unless (length ($name) and defined ($name));
  71   die "double defined name '$name' - aborted" if ( exists ( $conf -> {$name} ) );
  72
  73   # Wert eintragen
  74   $conf -> {$name} = ($node -> hasChildNodes)?$node -> getFirstChild -> getData:undef;
  75
  76   return;
  77 }
  78
  79 sub add_prop ($$) {
  80   my ($node, $conf) = @_;
  81
  82   my $name = $node -> getAttribute ('name');
  83
  84   die "element 'Property' requires attribute 'name' - aborted" unless (length ($name));
  85
  86   my @props  = $node -> getElementsByTagName ('Property', 0);
  87   my @vars = $node -> getElementsByTagName ('Variable', 0);
  88   my @lists  = $node -> getElementsByTagName ('List', 0);
  89
  90   # Properties
  91   if (@props) {
  92     for (@props) {
  93       my $hash = (defined $conf -> {$name})?$conf -> {$name}:{};
  94
  95       die "name '$name' is defined for 'Property' and 'Variable' - aborted" unless (ref $hash eq 'HASH');
  96
  97       &add_prop ($_, $hash);
  98       $conf -> {$name} = $hash;}}
  99
 100   # Array
 101   if (@lists) {
 102     for (@lists) {
 103       my $lname = $_ -> getAttribute ('name');
 104
 105       die "element 'List' requires attribute 'name' - aborted" unless (length ($lname) and defined ($lname));
 106       die "double defined name '$lname' - aborted" if ( exists ( $conf -> {$name} -> {$lname} ) );
 107
 108       $conf -> {$name} -> {$lname} = [map {($_ -> hasChildNodes)?$_ -> getFirstChild -> getData:undef} $_ -> getElementsByTagName ('ListItem', 0)];}}
 109
 110   # Hash
 111   if (@vars) {
 112     for (@vars) {
 113       my $vname = $_ -> getAttribute ('name');
 114
 115       die "element 'Variable' requires attribute 'name' - aborted" unless (length ($vname) and defined ($vname));
 116       die "double defined name '$vname' - aborted" if ( exists ( $conf -> {$name} -> {$vname} ) );
 117
 118       $conf -> {$name} -> {$vname} = ($_ -> hasChildNodes)?$_ -> getFirstChild -> getData:undef;}}
 119
 120   return;
 121 }
 122
 123 sub add_limit ($$$) {
 124   my ($node, $conf, $Script) = @_;
 125
 126   my %apps = map {($_ -> getFirstChild -> getData => 1)}
 127                    $node -> getElementsByTagName ('Application',0) -> item (0)
 128                    -> getElementsByTagName ('Script',0);
 129
 130   if ($apps {$Script}) {
 131     foreach ($node -> getElementsByTagName ('Constant', 0)) {&add_data ($_, $conf)}
 132     foreach ($node -> getElementsByTagName ('Property', 0)) {&add_prop ($_, $conf)}}
 133
 134   return;
 135 }
 136
 137 # ====================================================
 138 # Modulinitialisierung
 139 # ====================================================
 140
 141 # making require happy
 142 1;
 143
 144 # ====================================================
 145 # end of Conf
 146 # ====================================================
 147
 148 package Conf::Test;sub show{print"Content-type: text/plain\n\n";&hash($_[
 149 0],'')}sub hash{my($ref,$string)=@_;foreach(sort keys%$ref){my$val=$ref->
 150 {$_};unless(ref($val)){print$string,$_,' = ',$val,"\n";next;}else{if(ref(
 151 $val)eq 'HASH'){&hash($val,"$string$_ -> ");}else{if(ref($val)eq'ARRAY'){
 152 &array($val,"$string$_ -> ");}}}}}sub array {my($ref,$string)=@_;my $i=0;
 153 foreach (@$ref){unless(ref($_)){print$string,"[$i] = ", $_,"\n";}else{if(
 154 ref($_)eq 'HASH'){&hash($_,"$string\[$i] -> ")}else{if(ref($_)eq'ARRAY'){
 155 &array($_,"$string\[$i] -> ");}}}$i++;}}# n.d.p./2001-01-05/lm:2001-01-19
 156 # FUNCTION: printing the configuration, USAGE: &Conf::Test::show ($conf);
 157
 158 # ====================================================
 159 # 'real' end of Conf .-))
 160 # ====================================================