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: 2010-12-24
  10 #
  11 # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann
  12 # Copyright (C) 2003-2011 Patrick Canterino
  13 # All Rights Reserved.
  14 #
  15 # This file can be distributed and/or modified under the terms of
  16 # of the Artistic License 1.0 (see also the LICENSE file found at
  17 # the top level of the Dev-Editor distribution).
  18 #
  19
  20 use strict;
  21
  22 use vars qw(@EXPORT);
  23 use Carp qw(croak);
  24
  25 use Text::ParseWords;
  26
  27 ### Export ###
  28
  29 use base qw(Exporter);
  30
  31 @EXPORT = qw(read_config);
  32
  33 # This variable contains some dependencies for the "disable_commands"
  34 # configuration option.
  35 # The Hash key defines a command, the value is an Array Reference or String
  36 # defining the commands that will also be disabled.
  37
  38 my %disable_dependency = ('beginedit' => 'endedit',
  39                           'remove' => 'remove_multi',
  40                           '@write' => ['beginedit','endedit','copy','rename','remove','remove_multi','mkdir','mkfile','upload','chprop']);
  41
  42 # read_config()
  43 #
  44 # Read the configuration files of Dev-Editor
  45 #
  46 # Params: Path to main configuration file
  47 #
  48 # Return: Configuration (Hash Reference)
  49
  50 sub read_config($)
  51 {
  52  my $file = shift;
  53
  54  my $config = parse_config($file);
  55
  56  $config->{'errors'}    = parse_config($config->{'error_file'});
  57  $config->{'templates'} = parse_config($config->{'template_file'});
  58
  59  # Check if we have to parse the user config file
  60
  61  if($ENV{'REMOTE_USER'} && $config->{'userconf_file'} && -f $config->{'userconf_file'})
  62  {
  63   my $userconf = parse_config($config->{'userconf_file'});
  64
  65   # Parse aliases (we use references, so we won't get a memory
  66   # problem so soon...)
  67
  68   foreach my $user(keys(%$userconf))
  69   {
  70    if(my $aliases = $userconf->{$user}->{'aliases'})
  71    {
  72     foreach my $alias(parse_line('\s+',0,$aliases))
  73     {
  74      $userconf->{$alias} = $userconf->{$user} unless($userconf->{$alias});
  75     }
  76    }
  77   }
  78
  79   if($userconf->{$ENV{'REMOTE_USER'}})
  80   {
  81    # The current HTTP Auth user has got an individual configuration
  82    # Overwrite the default values
  83
  84    my $new_conf = $userconf->{$ENV{'REMOTE_USER'}};
  85
  86    $config->{'fileroot'}         = $new_conf->{'fileroot'}  if($new_conf->{'fileroot'});
  87    $config->{'httproot'}         = $new_conf->{'httproot'}  if($new_conf->{'httproot'});
  88    $config->{'startdir'}         = $new_conf->{'startdir'}  if($new_conf->{'startdir'});
  89
  90    $config->{'forbidden'}        = $new_conf->{'forbidden'} if(defined $new_conf->{'forbidden'});
  91    $config->{'disable_commands'} = $new_conf->{'disable_commands'} if(defined $new_conf->{'disable_commands'});
  92
  93    $config->{'hide_dot_files'}   = $new_conf->{'hide_dot_files'} if(defined $new_conf->{'hide_dot_files'});
  94
  95    $config->{'user_config'}      = 1;
  96   }
  97  }
  98
  99  # Parse list of forbidden files
 100
 101  if($config->{'forbidden'})
 102  {
 103   my @files;
 104
 105   foreach my $file(parse_line('\s+',0,$config->{'forbidden'}))
 106   {
 107    $file =~ tr!\\!/!;
 108
 109    $file =  '/'.$file unless($file =~ m!^/!);
 110    $file =~ s!/+$!!g;
 111
 112    push(@files,$file);
 113   }
 114
 115   $config->{'forbidden'} = \@files;
 116  }
 117  else
 118  {
 119   $config->{'forbidden'} = [];
 120  }
 121
 122  # Parse list of disabled commands (we need some universal code!)
 123
 124  if($config->{'disable_commands'})
 125  {
 126   my @commands;
 127
 128   foreach my $command(parse_line('\s+',0,$config->{'disable_commands'}))
 129   {
 130    push(@commands,$command) unless(substr($command,0,1) eq '@');
 131
 132    if(exists($disable_dependency{$command}) && $disable_dependency{$command})
 133    {
 134     if(ref($disable_dependency{$command}) eq 'ARRAY')
 135     {
 136      push(@commands,@{$disable_dependency{$command}});
 137     }
 138     else
 139     {
 140      push(@commands,$disable_dependency{$command});
 141     }
 142    }
 143   }
 144
 145   $config->{'disable_commands'} = \@commands;
 146  }
 147  else
 148  {
 149   $config->{'disable_commands'} = [];
 150  }
 151
 152  return $config;
 153 }
 154
 155 # parse_config()
 156 #
 157 # Parse a configuration file
 158 #
 159 # Params: Path to configuration file
 160 #
 161 # Return: Configuration (Hash Reference)
 162
 163 sub parse_config($)
 164 {
 165  my $file = shift;
 166  local *CF;
 167
 168  open(CF,'<'.$file) or croak("Open $file: $!");
 169  read(CF, my $data, -s $file);
 170  close(CF);
 171
 172  my @lines  = split(/\015\012|\012|\015/,$data);
 173  my $config = {};
 174  my $count  = 0;
 175  my $sect;
 176
 177  foreach my $line(@lines)
 178  {
 179   $count++;
 180
 181   next if($line =~ /^\s*#/);
 182
 183   if($line =~ /^\s*\[(\S+)\]\s*$/)
 184   {
 185    # Switch to new section
 186
 187    $sect = $1;
 188   }
 189   elsif($line =~ /^\s*\S+\s*=.*$/)
 190   {
 191    # A normal "key = value" line
 192
 193    my ($key,$value) = split(/=/,$line,2);
 194
 195    # Remove whitespaces at the beginning and at the end
 196
 197    $key   =~ s/^\s+//g;
 198    $key   =~ s/\s+$//g;
 199    $value =~ s/^\s+//g;
 200    $value =~ s/\s+$//g;
 201
 202    if($sect)
 203    {
 204     $config->{$sect} = {} if(ref($config->{$sect}) ne 'HASH');
 205
 206     croak "Configuration option '$key' of section '$sect' defined twice in line $count of configuration file '$file'" if($config->{$sect}->{$key});
 207
 208     $config->{$sect}->{$key} = $value;
 209    }
 210    else
 211    {
 212     croak "Configuration option '$key' defined twice in line $count of configuration file '$file'" if($config->{$key});
 213
 214     $config->{$key} = $value;
 215    }
 216   }
 217  }
 218
 219  return $config;
 220 }
 221
 222 # it's true, baby ;-)
 223
 224 1;
 225
 226 #
 227 ### End ###