X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/45dab0a69a6d22dd13aa625970c4b673afea535c..d224f56a90829daccb53490b9163f37efd61350c:/modules/Config/DevEdit.pm diff --git a/modules/Config/DevEdit.pm b/modules/Config/DevEdit.pm index 24b3fe1..bc93cfe 100644 --- a/modules/Config/DevEdit.pm +++ b/modules/Config/DevEdit.pm @@ -5,8 +5,8 @@ package Config::DevEdit; # # Read and parse the configuration files # -# Author: Patrick Canterino -# Last modified: 2004-10-28 +# Author: Patrick Canterino +# Last modified: 2005-09-30 # use strict; @@ -14,6 +14,8 @@ use strict; use vars qw(@EXPORT); use Carp qw(croak); +use Text::ParseWords; + ### Export ### use base qw(Exporter); @@ -24,7 +26,7 @@ use base qw(Exporter); # # Read the configuration files of Dev-Editor # -# Params: Path to configuration file +# Params: Path to main configuration file # # Return: Configuration (Hash Reference) @@ -37,6 +39,65 @@ sub read_config($) $config->{'errors'} = parse_config($config->{'error_file'}); $config->{'templates'} = parse_config($config->{'template_file'}); + # Check if we have to parse the user config file + + if($ENV{'REMOTE_USER'} && $config->{'userconf_file'} && -f $config->{'userconf_file'}) + { + my $userconf = parse_config($config->{'userconf_file'}); + + # Parse aliases (we use references, so we won't get a memory + # problem so soon...) + + foreach my $user(keys(%$userconf)) + { + if(my $aliases = $userconf->{$user}->{'aliases'}) + { + foreach my $alias(parse_line('\s+',0,$aliases)) + { + $userconf->{$alias} = $userconf->{$user} unless($userconf->{$alias}); + } + } + } + + if($userconf->{$ENV{'REMOTE_USER'}}) + { + # The current HTTP Auth user has got an individual configuration + # Overwrite the default values + + my $new_conf = $userconf->{$ENV{'REMOTE_USER'}}; + + $config->{'fileroot'} = $new_conf->{'fileroot'} if($new_conf->{'fileroot'}); + $config->{'httproot'} = $new_conf->{'httproot'} if($new_conf->{'httproot'}); + + $config->{'forbidden'} = $new_conf->{'forbidden'} if(defined $new_conf->{'forbidden'}); + + $config->{'user_config'} = 1; + } + } + + # Parse list of forbidden files + + if($config->{'forbidden'}) + { + my @files; + + foreach my $file(parse_line('\s+',0,$config->{'forbidden'})) + { + $file =~ tr!\\!/!; + + $file = '/'.$file unless($file =~ m!^/!); + $file =~ s!/+$!!g; + + push(@files,$file); + } + + $config->{'forbidden'} = \@files; + } + else + { + $config->{'forbidden'} = []; + } + return $config; } @@ -53,30 +114,55 @@ sub parse_config($) my $file = shift; local *CF; - open(CF,"<$file") or croak("Open $file: $!"); + open(CF,'<'.$file) or croak("Open $file: $!"); read(CF, my $data, -s $file); close(CF); my @lines = split(/\015\012|\012|\015/,$data); my $config = {}; + my $count = 0; + my $sect; foreach my $line(@lines) { + $count++; + next if($line =~ /^\s*#/); - next if($line !~ /^.+=.+$/); - my ($key,$value) = split(/=/,$line,2); + if($line =~ /^\s*\[(\S+)\]\s*$/) + { + # Switch to new section + + $sect = $1; + } + elsif($line =~ /^\s*\S+\s*=.*$/) + { + # A normal "key = value" line + + my ($key,$value) = split(/=/,$line,2); + + # Remove whitespaces at the beginning and at the end + + $key =~ s/^\s+//g; + $key =~ s/\s+$//g; + $value =~ s/^\s+//g; + $value =~ s/\s+$//g; - # Remove whitespaces at the beginning and at the end + if($sect) + { + $config->{$sect} = {} if(ref($config->{$sect}) ne 'HASH'); - $key =~ s/^\s+//g; - $key =~ s/\s+$//g; - $value =~ s/^\s+//g; - $value =~ s/\s+$//g; + croak "Configuration option '$key' of section '$sect' defined twice in line $count of configuration file '$file'" if($config->{$sect}->{$key}); - croak "Double defined value '$key' in configuration file '$file'" if($config->{$key}); + $config->{$sect}->{$key} = $value; + } + else + { + croak "Configuration option '$key' defined twice in line $count of configuration file '$file'" if($config->{$key}); - $config->{$key} = $value; + $config->{$key} = $value; + } + } } return $config;