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-23
  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
  40 # read_config()
  41 #
  42 # Read the configuration files of Dev-Editor
  43 #
  44 # Params: Path to main configuration file
  45 #
  46 # Return: Configuration (Hash Reference)
  47
  48 sub read_config($)
  49 {
  50  my $file = shift;
  51
  52  my $config = parse_config($file);
  53
  54  $config->{'errors'}    = parse_config($config->{'error_file'});
  55  $config->{'templates'} = parse_config($config->{'template_file'});
  56
  57  # Check if we have to parse the user config file
  58
  59  if($ENV{'REMOTE_USER'} && $config->{'userconf_file'} && -f $config->{'userconf_file'})
  60  {
  61   my $userconf = parse_config($config->{'userconf_file'});
  62
  63   # Parse aliases (we use references, so we won't get a memory
  64   # problem so soon...)
  65
  66   foreach my $user(keys(%$userconf))
  67   {
  68    if(my $aliases = $userconf->{$user}->{'aliases'})
  69    {
  70     foreach my $alias(parse_line('\s+',0,$aliases))
  71     {
  72      $userconf->{$alias} = $userconf->{$user} unless($userconf->{$alias});
  73     }
  74    }
  75   }
  76
  77   if($userconf->{$ENV{'REMOTE_USER'}})
  78   {
  79    # The current HTTP Auth user has got an individual configuration
  80    # Overwrite the default values
  81
  82    my $new_conf = $userconf->{$ENV{'REMOTE_USER'}};
  83
  84    $config->{'fileroot'}         = $new_conf->{'fileroot'}  if($new_conf->{'fileroot'});
  85    $config->{'httproot'}         = $new_conf->{'httproot'}  if($new_conf->{'httproot'});
  86
  87    $config->{'forbidden'}        = $new_conf->{'forbidden'} if(defined $new_conf->{'forbidden'});
  88    $config->{'disable_commands'} = $new_conf->{'disable_commands'} if(defined $new_conf->{'disable_commands'});
  89
  90    $config->{'hide_dot_files'}   = $new_conf->{'hide_dot_files'} if(defined $new_conf->{'hide_dot_files'});
  91
  92    $config->{'user_config'}      = 1;
  93   }
  94  }
  95
  96  # Parse list of forbidden files
  97
  98  if($config->{'forbidden'})
  99  {
 100   my @files;
 101
 102   foreach my $file(parse_line('\s+',0,$config->{'forbidden'}))
 103   {
 104    $file =~ tr!\\!/!;
 105
 106    $file =  '/'.$file unless($file =~ m!^/!);
 107    $file =~ s!/+$!!g;
 108
 109    push(@files,$file);
 110   }
 111
 112   $config->{'forbidden'} = \@files;
 113  }
 114  else
 115  {
 116   $config->{'forbidden'} = [];
 117  }
 118
 119  # Parse list of disabled commands (we need some universal code!)
 120
 121  if($config->{'disable_commands'})
 122  {
 123   my @commands;
 124
 125   foreach my $command(parse_line('\s+',0,$config->{'disable_commands'}))
 126   {
 127    push(@commands,$command);
 128
 129    if(exists($disable_dependency{$command}) && $disable_dependency{$command})
 130    {
 131     if(ref($disable_dependency{$command}) eq 'ARRAY')
 132     {
 133      push(@commands,@{$disable_dependency{$command}});
 134     }
 135     else
 136     {
 137      push(@commands,$disable_dependency{$command});
 138     }
 139    }
 140   }
 141
 142   $config->{'disable_commands'} = \@commands;
 143  }
 144  else
 145  {
 146   $config->{'disable_commands'} = [];
 147  }
 148
 149  return $config;
 150 }
 151
 152 # parse_config()
 153 #
 154 # Parse a configuration file
 155 #
 156 # Params: Path to configuration file
 157 #
 158 # Return: Configuration (Hash Reference)
 159
 160 sub parse_config($)
 161 {
 162  my $file = shift;
 163  local *CF;
 164
 165  open(CF,'<'.$file) or croak("Open $file: $!");
 166  read(CF, my $data, -s $file);
 167  close(CF);
 168
 169  my @lines  = split(/\015\012|\012|\015/,$data);
 170  my $config = {};
 171  my $count  = 0;
 172  my $sect;
 173
 174  foreach my $line(@lines)
 175  {
 176   $count++;
 177
 178   next if($line =~ /^\s*#/);
 179
 180   if($line =~ /^\s*\[(\S+)\]\s*$/)
 181   {
 182    # Switch to new section
 183
 184    $sect = $1;
 185   }
 186   elsif($line =~ /^\s*\S+\s*=.*$/)
 187   {
 188    # A normal "key = value" line
 189
 190    my ($key,$value) = split(/=/,$line,2);
 191
 192    # Remove whitespaces at the beginning and at the end
 193
 194    $key   =~ s/^\s+//g;
 195    $key   =~ s/\s+$//g;
 196    $value =~ s/^\s+//g;
 197    $value =~ s/\s+$//g;
 198
 199    if($sect)
 200    {
 201     $config->{$sect} = {} if(ref($config->{$sect}) ne 'HASH');
 202
 203     croak "Configuration option '$key' of section '$sect' defined twice in line $count of configuration file '$file'" if($config->{$sect}->{$key});
 204
 205     $config->{$sect}->{$key} = $value;
 206    }
 207    else
 208    {
 209     croak "Configuration option '$key' defined twice in line $count of configuration file '$file'" if($config->{$key});
 210
 211     $config->{$key} = $value;
 212    }
 213   }
 214  }
 215
 216  return $config;
 217 }
 218
 219 # it's true, baby ;-)
 220
 221 1;
 222
 223 #
 224 ### End ###