]> git.p6c8.net - devedit.git/blob - modules/Config/DevEdit.pm
aa76b5ebbc190d1286453e81994569c8e0385ee3
[devedit.git] / modules / Config / DevEdit.pm
1 package Config::DevEdit;
2
3 #
4 # Dev-Editor - Module Config::DevEdit
5 #
6 # Read and parse the configuration files
7 #
8 # Author: Patrick Canterino <patrick@patshaping.de>
9 # Last modified: 2005-08-24
10 #
11
12 use strict;
13
14 use vars qw(@EXPORT);
15 use Carp qw(croak);
16
17 use Text::ParseWords;
18
19 ### Export ###
20
21 use base qw(Exporter);
22
23 @EXPORT = qw(read_config);
24
25 # read_config()
26 #
27 # Read the configuration files of Dev-Editor
28 #
29 # Params: Path to main configuration file
30 #
31 # Return: Configuration (Hash Reference)
32
33 sub read_config($)
34 {
35 my $file = shift;
36
37 my $config = parse_config($file);
38
39 $config->{'errors'} = parse_config($config->{'error_file'});
40 $config->{'templates'} = parse_config($config->{'template_file'});
41
42 # Check if we have to parse the user config file
43
44 if($ENV{'REMOTE_USER'} && $config->{'userconf_file'} && -f $config->{'userconf_file'})
45 {
46 my $userconf = parse_config($config->{'userconf_file'});
47
48 if($userconf->{$ENV{'REMOTE_USER'}})
49 {
50 # The current HTTP Auth user has got an individual configuration
51 # Overwrite the default values
52
53 my $new_conf = $userconf->{$ENV{'REMOTE_USER'}};
54
55 $config->{'fileroot'} = $new_conf->{'fileroot'} if($new_conf->{'fileroot'});
56 $config->{'httproot'} = $new_conf->{'httproot'} if($new_conf->{'httproot'});
57
58 $config->{'forbidden'} = $new_conf->{'forbidden'} if(defined $new_conf->{'forbidden'});
59
60 $config->{'user_config'} = 1;
61 }
62 }
63
64 # Parse list of forbidden files
65
66 if($config->{'forbidden'})
67 {
68 my @files;
69
70 foreach my $file(parse_line('\s+',0,$config->{'forbidden'}))
71 {
72 $file =~ tr!\\!/!;
73
74 $file = '/'.$file unless($file =~ m!^/!);
75 $file =~ s!/+$!!g;
76
77 push(@files,$file);
78 }
79
80 $config->{'forbidden'} = \@files;
81 }
82 else
83 {
84 $config->{'forbidden'} = [];
85 }
86
87 return $config;
88 }
89
90 # parse_config()
91 #
92 # Parse a configuration file
93 #
94 # Params: Path to configuration file
95 #
96 # Return: Configuration (Hash Reference)
97
98 sub parse_config($)
99 {
100 my $file = shift;
101 local *CF;
102
103 open(CF,'<'.$file) or croak("Open $file: $!");
104 read(CF, my $data, -s $file);
105 close(CF);
106
107 my @lines = split(/\015\012|\012|\015/,$data);
108 my $config = {};
109 my $count = 0;
110 my $sect;
111
112 foreach my $line(@lines)
113 {
114 $count++;
115
116 next if($line =~ /^\s*#/);
117
118 if($line =~ /^\s*\[(\S+)\]\s*$/)
119 {
120 # Switch to new section
121
122 $sect = $1;
123 }
124 elsif($line =~ /^\s*\S+\s*=.*$/)
125 {
126 # A normal "key = value" line
127
128 my ($key,$value) = split(/=/,$line,2);
129
130 # Remove whitespaces at the beginning and at the end
131
132 $key =~ s/^\s+//g;
133 $key =~ s/\s+$//g;
134 $value =~ s/^\s+//g;
135 $value =~ s/\s+$//g;
136
137 if($sect)
138 {
139 $config->{$sect} = {} if(ref($config->{$sect}) ne 'HASH');
140
141 croak "Configuration option '$key' of section '$sect' defined twice in line $count of configuration file '$file'" if($config->{$sect}->{$key});
142
143 $config->{$sect}->{$key} = $value;
144 }
145 else
146 {
147 croak "Configuration option '$key' defined twice in line $count of configuration file '$file'" if($config->{$key});
148
149 $config->{$key} = $value;
150 }
151 }
152 }
153
154 return $config;
155 }
156
157 # it's true, baby ;-)
158
159 1;
160
161 #
162 ### End ###

patrick-canterino.de