selfforum-cgi/shared/Conf.pm

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