selfforum-cgi/shared/Conf.pm

   1 package Conf;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Conf.pm                                                  #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>                                      #
   8 #                                                                              #
   9 # Description: read and parse configuration files                              #
  10 #                                                                              #
  11 ################################################################################
  12
  13 use strict;
  14 use vars qw(
  15   @EXPORT
  16 );
  17
  18 use XML::DOM;
  19
  20 ################################################################################
  21 #
  22 # Version check
  23 #
  24 # last modified:
  25 #    $Date$ (GMT)
  26 # by $Author$
  27 #
  28 sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
  29
  30 ################################################################################
  31 #
  32 # Export
  33 #
  34 use base qw(Exporter);
  35 @EXPORT = qw(read_script_conf);
  36
  37 ### add_limit () ###############################################################
  38 #
  39 # add limited data
  40 #
  41 # Params: $node   - element node
  42 #         $conf   - hashref of config hash (will be modified)
  43 #         $Script - scriptname (first name)
  44 #
  45 # Return: ~none~
  46 #
  47 sub add_limit ($$$) {
  48   my ($node, $conf, $Script) = @_;
  49
  50   my %apps = map {($_ -> getFirstChild -> getData => 1)}
  51                    $node -> getElementsByTagName ('Application',0) -> item (0)
  52                    -> getElementsByTagName ('Script',0);
  53
  54   if ($apps {$Script}) {
  55     foreach ($node -> getElementsByTagName ('Constant', 0)) {add_data ($_, $conf)}
  56     foreach ($node -> getElementsByTagName ('Property', 0)) {add_prop ($_, $conf)}}
  57
  58   return;
  59 }
  60
  61 ### add_prop () ################################################################
  62 #
  63 # add a property (recursive if necessary)
  64 #
  65 # Params: $node - element node
  66 #         $conf - hashref of config hash (will be modified)
  67 #
  68 # Return: ~none~
  69 #
  70 sub add_prop ($$) {
  71   my ($node, $conf) = @_;
  72
  73   my $name = $node -> getAttribute ('name');
  74
  75   die "element 'Property' requires attribute 'name' - aborted" unless (length ($name));
  76
  77   my @props  = $node -> getElementsByTagName ('Property', 0);
  78   my @vars = $node -> getElementsByTagName ('Variable', 0);
  79   my @lists  = $node -> getElementsByTagName ('List', 0);
  80
  81   # Properties
  82   #
  83   if (@props) {
  84     for (@props) {
  85       my $hash = (defined $conf -> {$name})?$conf -> {$name}:{};
  86
  87       die "name '$name' is defined for 'Property' and 'Variable' - aborted" unless (ref $hash eq 'HASH');
  88
  89       &add_prop ($_, $hash);
  90       $conf -> {$name} = $hash;}}
  91
  92   # Array
  93   #
  94   if (@lists) {
  95     for (@lists) {
  96       my $lname = $_ -> getAttribute ('name');
  97
  98       die "element 'List' requires attribute 'name' - aborted" unless (length ($lname) and defined ($lname));
  99       die "double defined name '$lname' - aborted" if ( exists ( $conf -> {$name} -> {$lname} ) );
 100
 101       $conf -> {$name} -> {$lname} = [map {($_ -> hasChildNodes)?$_ -> getFirstChild -> getData:undef} $_ -> getElementsByTagName ('ListItem', 0)];}}
 102
 103   # Hash
 104   #
 105   if (@vars) {
 106     for (@vars) {
 107       my $vname = $_ -> getAttribute ('name');
 108
 109       die "element 'Variable' requires attribute 'name' - aborted" unless (length ($vname) and defined ($vname));
 110       die "double defined name '$vname' - aborted" if ( exists ( $conf -> {$name} -> {$vname} ) );
 111
 112       $conf -> {$name} -> {$vname} = ($_ -> hasChildNodes)?$_ -> getFirstChild -> getData:undef;}}
 113
 114   return;
 115 }
 116
 117 ### add_data () ################################################################
 118 #
 119 # add a real value (Constant or Variable)
 120 #
 121 # Params: $node - Element node
 122 #         $conf - hashref of config hash (will be modified)
 123 #
 124 # Return: ~none~
 125 #
 126 sub add_data ($$) {
 127   my ($node, $conf) = @_;
 128   my $name = $node -> getAttribute ('name');
 129
 130   die q"element '".$node -> getNodeName.q"' requires attribute 'name' - aborted" unless (length ($name) and defined ($name));
 131   die q"double defined name '$name' - aborted" if ( exists ( $conf -> {$name} ) );
 132
 133   $conf -> {$name} = ($node -> hasChildNodes)?$node -> getFirstChild -> getData:undef;
 134
 135   return;
 136 }
 137
 138 ### parse_script_conf () #######################################################
 139 #
 140 # parse a config file
 141 #
 142 # Params: $filename - filename
 143 #         $conf     - hashref of config hash (hash will be modified)
 144 #         $Script   - scriptname
 145 #
 146 # Return: ~none~
 147 #
 148 sub parse_script_conf ($\%$) {
 149   my ($filename, $conf, $Script) = @_;
 150
 151   if (-f $filename) {
 152     my $xml = new XML::DOM::Parser -> parsefile ($filename);
 153     my $config = $xml -> getElementsByTagName ('Config', 0) -> item (0);
 154
 155     add_data  $_, $conf          for ($config -> getElementsByTagName ('Constant', 0));
 156     add_prop  $_, $conf          for ($config -> getElementsByTagName ('Property', 0));
 157     add_limit $_, $conf, $Script for ($config -> getElementsByTagName ('Limit', 0));
 158   }
 159
 160   return;
 161 }
 162
 163 ### read_script_conf () ########################################################
 164 #
 165 # read and parse whole script config.
 166 #
 167 # Params: $Config - /path/to/config-dir   # NO trailing slash please
 168 #         $Shared - /path/to/shared-dir   #        -- " --
 169 #         $Script - scriptname
 170 #
 171 sub read_script_conf ($$$) {
 172   my ($Config, $Shared, $Script) = @_;
 173
 174   $Script =~ s/^(.*)\..*$/$1/;             # extract script's 'first name'
 175   my $common  = "$Shared/common.xml";      # shared config file
 176   my $group   = "$Config/common.xml";      # group config file
 177   my $special = "$Config/$Script.xml";     # special script config file
 178   my %conf=();                             # config hash
 179
 180   parse_script_conf ($common , %conf, $Script);
 181   parse_script_conf ($group,   %conf, $Script);
 182   parse_script_conf ($special, %conf, $Script);
 183
 184   # return
 185   #
 186   \%conf;
 187 }
 188
 189 # keep 'require' happy
 190 1;
 191
 192 #
 193 #
 194 ### end of Conf ################################################################
 195
 196 ### show() #####################################################################
 197 #
 198 # mini data dumper
 199 #
 200 # Usage: Conf::Test::show (hashref)
 201 #
 202 package Conf::Test;sub show{print"Content-type: text/plain\n\n";&hash($_[
 203 0],'')}sub hash{my($ref,$string)=@_;foreach(sort keys%$ref){my$val=$ref->
 204 {$_};unless(ref($val)){print$string,$_,' = ',$val,"\n";next;}else{if(ref(
 205 $val)eq 'HASH'){&hash($val,"$string$_ -> ");}else{if(ref($val)eq'ARRAY'){
 206 &array($val,"$string$_ -> ");}}}}}sub array {my($ref,$string)=@_;my $i=0;
 207 foreach (@$ref){unless(ref($_)){print$string,"[$i] = ", $_,"\n";}else{if(
 208 ref($_)eq 'HASH'){&hash($_,"$string\[$i] -> ")}else{if(ref($_)eq'ARRAY'){
 209 &array($_,"$string\[$i] -> ");}}}$i++;}}# n.d.p./2001-01-05/lm:2001-01-19
 210 # FUNCTION: printing the configuration, USAGE: &Conf::Test::show ($conf);
 211
 212 #
 213 #
 214 ### *real* end of Conf ;-) #####################################################