]> git.p6c8.net - selfforum.git/blob - selfforum-cgi/shared/Conf.pm
Replaced fo_posting.xml by fo_posting.xml-default.
[selfforum.git] / 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 ($Config, $Shared, $Script) = @_;
32
33 $Script =~ s/^(.*)\..*$/$1/; # Vornamen extrahieren
34 my $common = "$Shared/common.xml"; # gemeinsame Konf-datei
35 my $group = "$Config/common.xml"; # gemeinsame (Gruppen-)Konf-datei
36 my $special = "$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 # ====================================================

patrick-canterino.de