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-2009 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
  89    $config->{'forbidden'}        = $new_conf->{'forbidden'} if(defined $new_conf->{'forbidden'});
  90    $config->{'disable_commands'} = $new_conf->{'disable_commands'} if(defined $new_conf->{'disable_commands'});
  91
  92    $config->{'hide_dot_files'}   = $new_conf->{'hide_dot_files'} if(defined $new_conf->{'hide_dot_files'});
  93
  94    $config->{'user_config'}      = 1;
  95   }
  96  }
  97
  98  # Parse list of forbidden files
  99
 100  if($config->{'forbidden'})
 101  {
 102   my @files;
 103
 104   foreach my $file(parse_line('\s+',0,$config->{'forbidden'}))
 105   {
 106    $file =~ tr!\\!/!;
 107
 108    $file =  '/'.$file unless($file =~ m!^/!);
 109    $file =~ s!/+$!!g;
 110
 111    push(@files,$file);
 112   }
 113
 114   $config->{'forbidden'} = \@files;
 115  }
 116  else
 117  {
 118   $config->{'forbidden'} = [];
 119  }
 120
 121  # Parse list of disabled commands (we need some universal code!)
 122
 123  if($config->{'disable_commands'})
 124  {
 125   my @commands;
 126
 127   foreach my $command(parse_line('\s+',0,$config->{'disable_commands'}))
 128   {
 129    push(@commands,$command) unless(substr($command,0,1) eq '@');
 130
 131    if(exists($disable_dependency{$command}) && $disable_dependency{$command})
 132    {
 133     if(ref($disable_dependency{$command}) eq 'ARRAY')
 134     {
 135      push(@commands,@{$disable_dependency{$command}});
 136     }
 137     else
 138     {
 139      push(@commands,$disable_dependency{$command});
 140     }
 141    }
 142   }
 143
 144   $config->{'disable_commands'} = \@commands;
 145  }
 146  else
 147  {
 148   $config->{'disable_commands'} = [];
 149  }
 150
 151  return $config;
 152 }
 153
 154 # parse_config()
 155 #
 156 # Parse a configuration file
 157 #
 158 # Params: Path to configuration file
 159 #
 160 # Return: Configuration (Hash Reference)
 161
 162 sub parse_config($)
 163 {
 164  my $file = shift;
 165  local *CF;
 166
 167  open(CF,'<'.$file) or croak("Open $file: $!");
 168  read(CF, my $data, -s $file);
 169  close(CF);
 170
 171  my @lines  = split(/\015\012|\012|\015/,$data);
 172  my $config = {};
 173  my $count  = 0;
 174  my $sect;
 175
 176  foreach my $line(@lines)
 177  {
 178   $count++;
 179
 180   next if($line =~ /^\s*#/);
 181
 182   if($line =~ /^\s*\[(\S+)\]\s*$/)
 183   {
 184    # Switch to new section
 185
 186    $sect = $1;
 187   }
 188   elsif($line =~ /^\s*\S+\s*=.*$/)
 189   {
 190    # A normal "key = value" line
 191
 192    my ($key,$value) = split(/=/,$line,2);
 193
 194    # Remove whitespaces at the beginning and at the end
 195
 196    $key   =~ s/^\s+//g;
 197    $key   =~ s/\s+$//g;
 198    $value =~ s/^\s+//g;
 199    $value =~ s/\s+$//g;
 200
 201    if($sect)
 202    {
 203     $config->{$sect} = {} if(ref($config->{$sect}) ne 'HASH');
 204
 205     croak "Configuration option '$key' of section '$sect' defined twice in line $count of configuration file '$file'" if($config->{$sect}->{$key});
 206
 207     $config->{$sect}->{$key} = $value;
 208    }
 209    else
 210    {
 211     croak "Configuration option '$key' defined twice in line $count of configuration file '$file'" if($config->{$key});
 212
 213     $config->{$key} = $value;
 214    }
 215   }
 216  }
 217
 218  return $config;
 219 }
 220
 221 # it's true, baby ;-)
 222
 223 1;
 224
 225 #
 226 ### End ###