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