X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/83d16ffce3d208854a53647d8644e3498db9689c..d468eee260bc122ffca5b4584bd7a395c7e5dbf2:/modules/Config/DevEdit.pm?ds=inline diff --git a/modules/Config/DevEdit.pm b/modules/Config/DevEdit.pm index 9b3cc6c..b4cb963 100644 --- a/modules/Config/DevEdit.pm +++ b/modules/Config/DevEdit.pm @@ -6,7 +6,15 @@ package Config::DevEdit; # Read and parse the configuration files # # Author: Patrick Canterino -# Last modified: 2004-12-31 +# Last modified: 2005-09-30 +# +# Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann +# Copyright (C) 2003-2009 Patrick Canterino +# All Rights Reserved. +# +# This file can be distributed and/or modified under the terms of +# of the Artistic License 1.0 (see also the LICENSE file found at +# the top level of the Dev-Editor distribution). # use strict; @@ -14,6 +22,8 @@ use strict; use vars qw(@EXPORT); use Carp qw(croak); +use Text::ParseWords; + ### Export ### use base qw(Exporter); @@ -37,6 +47,67 @@ 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->{'hide_dot_files'} = $new_conf->{'hide_dot_files'} if(defined $new_conf->{'hide_dot_files'}); + + $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 +124,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 !~ /^\s*\S+\s*=.+$/); - 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;