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