lib/TWiki/Configure/TWikiCfg.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 #
       
     2 # TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
     3 #
       
     4 # Copyright (C) 2000-2006 TWiki Contributors.
       
     5 #
       
     6 # This program is free software; you can redistribute it and/or
       
     7 # modify it under the terms of the GNU General Public License
       
     8 # as published by the Free Software Foundation; either version 2
       
     9 # of the License, or (at your option) any later version. For
       
    10 # more details read LICENSE in the root of this distribution.
       
    11 #
       
    12 # This program is distributed in the hope that it will be useful,
       
    13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
       
    14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
    15 #
       
    16 # As per the GPL, removal of this notice is prohibited.
       
    17 #
       
    18 # This is a both parser for configuration declaration files, such as
       
    19 # TWikiCfg.spec, and a serialisation visitor for writing out changes
       
    20 # to LocalSite.cfg
       
    21 #
       
    22 # The supported syntax in declaration files is as follows:
       
    23 #
       
    24 # cfg ::= ( setting | section | extension )* ;
       
    25 # setting ::= BOL typespec EOL comment* BOL def ;
       
    26 # typespec ::= "# **" id options "**" ;
       
    27 # def ::= "$" ["TWiki::"] "cfg" keys "=" value ";" ;
       
    28 # keys ::= ( "{" id "}" )+ ;
       
    29 # value is any perl value not including ";"
       
    30 # comment ::= BOL "#" string EOL ;
       
    31 # section ::= BOL "#--++" string EOL comment* ;
       
    32 # extension ::= BOL " *" id "*"
       
    33 # EOL ::= end of line
       
    34 # BOL ::= beginning of line
       
    35 # id ::= a \w+ word (legal Perl bareword)
       
    36 #
       
    37 # * A *section* is simply a divider used to create foldable blocks. It can
       
    38 #   have varying depth depending on the number of + signs
       
    39 # * A *setting* is the sugar required for the setting of a single
       
    40 #   configuration value.
       
    41 # * An *extension* is a pluggable UI extension that supports some extra UI
       
    42 #   functionality, such as the menu of languages or the menu of plugins.
       
    43 #
       
    44 # Each *setting* has a *typespec* and a *def*.
       
    45 #
       
    46 # The typespec consists of a type id and some options. Types are loaded by
       
    47 # type id from the TWiki::Configure::Types hierachy - for example, type
       
    48 # BOOLEAN is defined by TWiki::Configure::Types::BOOLEAN. Each type is a
       
    49 # subclass of TWiki::Configure::Type - see that class for more details of
       
    50 # what is supported.
       
    51 #
       
    52 # A *def* is a specification of a field in the $TWiki::cfg hash, together with
       
    53 # a perl value for that hash. Each field can have an associated *Checker*
       
    54 # which is loaded from the TWiki::Configure::Checkers hierarchy. Checkers
       
    55 # are responsible for specific checks on the value of that variable. For
       
    56 # example, the checker for $TWiki::cfg{Banana}{Republic} will be expected
       
    57 # to be found in TWiki::Configure::Checkers::Banana::Republic.
       
    58 # Checkers are subclasses of TWiki::Configure::Checker. See that class for
       
    59 # more details.
       
    60 #
       
    61 # An *extension* is a placeholder for a pluggable UI module.
       
    62 #
       
    63 package TWiki::Configure::TWikiCfg;
       
    64 
       
    65 use strict;
       
    66 use Data::Dumper;
       
    67 
       
    68 use TWiki::Configure::Section;
       
    69 use TWiki::Configure::Value;
       
    70 use TWiki::Configure::Pluggable;
       
    71 use TWiki::Configure::Item;
       
    72 
       
    73 # Used in saving, when we need a callback. Otherwise the methods here are
       
    74 # all static.
       
    75 sub new {
       
    76     my $class = shift;
       
    77 
       
    78     return bless({}, $class);
       
    79 }
       
    80 
       
    81 # Load the configuration declarations. The core set is defined in
       
    82 # TWiki.spec, which must be found on the @INC path and is always loaded
       
    83 # first. Then find all settings for extensions in their .spec files.
       
    84 #
       
    85 # This *only* reads type specifications, it *does not* read values.
       
    86 #
       
    87 # SEE ALSO TWiki::Configure::Load::readDefaults
       
    88 sub load {
       
    89     my ($root, $haveLSC) = @_;
       
    90 
       
    91     my $file = TWiki::findFileOnPath('TWiki.spec');
       
    92     if ($file) {
       
    93         _parse($file, $root, $haveLSC);
       
    94     }
       
    95     if ($haveLSC) {
       
    96         my %read;
       
    97         foreach my $dir (@INC) {
       
    98             _loadSpecsFrom("$dir/TWiki/Plugins", $root, \%read);
       
    99             _loadSpecsFrom("$dir/TWiki/Contrib", $root, \%read);
       
   100         }
       
   101     }
       
   102 }
       
   103 
       
   104 sub _loadSpecsFrom {
       
   105     my ($dir, $root, $read) = @_;
       
   106 
       
   107     return unless opendir(D, $dir);
       
   108     foreach my $extension ( grep { !/^\./ } readdir D) {
       
   109         next if $read->{$extension};
       
   110         my $file = "$dir/$extension/Config.spec";
       
   111         next unless -e $file;
       
   112         _parse($file, $root, 1);
       
   113         $read->{$extension} = $file;
       
   114     }
       
   115     closedir(D);
       
   116 }
       
   117 
       
   118 ###########################################################################
       
   119 ## INPUT
       
   120 ###########################################################################
       
   121 {
       
   122     # Inner class that represents section headings temporarily during the
       
   123     # parse. They are expanded to section blocks at the end.
       
   124     package SectionMarker;
       
   125 
       
   126     use base 'TWiki::Configure::Item';
       
   127 
       
   128     sub new {
       
   129         my ($class, $depth, $head) = @_;
       
   130         my $this = bless({}, $class);
       
   131         $this->{depth} = $depth + 1;
       
   132         $this->{head} = $head;
       
   133         return $this;
       
   134     }
       
   135 
       
   136     sub getValueObject { return undef; }
       
   137 }
       
   138 
       
   139 # Process the config array and add section objects
       
   140 sub _extractSections {
       
   141     my ($settings, $root) = @_;
       
   142 
       
   143     my $section = $root;
       
   144     my $depth = 0;
       
   145 
       
   146     foreach my $item (@$settings) {
       
   147         if ($item->isa('SectionMarker')) {
       
   148             my $ns = $root->getSectionObject($item->{head}, $item->{depth}+1);
       
   149             if ($ns) {
       
   150                 $depth = $item->{depth};
       
   151             } else {
       
   152                 while ($depth > $item->{depth} - 1) {
       
   153                     $section = $section->{parent};
       
   154                     $depth--;
       
   155                 }
       
   156                 while ($depth < $item->{depth} - 1) {
       
   157                     my $ns = new TWiki::Configure::Section('');
       
   158                     $section->addChild($ns);
       
   159                     $section = $ns;
       
   160                     $depth++;
       
   161                 }
       
   162                 $ns = new TWiki::Configure::Section($item->{head});
       
   163                 $ns->{desc} = $item->{desc};
       
   164                 $section->addChild($ns);
       
   165                 $depth++;
       
   166             }
       
   167             $section = $ns;
       
   168         } elsif ($item->isa('TWiki::Configure::Value')) {
       
   169             # Skip it if we already have a settings object for these
       
   170             # keys (first loaded always takes precedence, irrespective
       
   171             # of which section it is in)
       
   172             my $vo = $root->getValueObject($item->getKeys());
       
   173             next if ($vo);
       
   174             $section->addChild($item);
       
   175         } else {
       
   176             $section->addChild($item);
       
   177         }
       
   178     }
       
   179 }
       
   180 
       
   181 # See if we have already build a value object for these keys
       
   182 sub _getValueObject {
       
   183     my ($keys, $settings) = @_;
       
   184     foreach my $item (@$settings) {
       
   185         my $i = $item->getValueObject($keys);
       
   186         return $i if $i;
       
   187     }
       
   188     return undef;
       
   189 }
       
   190 
       
   191 # Parse the config declaration file and return a root node for the
       
   192 # configuration it describes
       
   193 sub _parse {
       
   194     my ($file, $root, $haveLSC) = @_;
       
   195 
       
   196     open(F, "<$file") || return '';
       
   197     local $/ = "\n";
       
   198     my $open = undef;
       
   199     my @settings;
       
   200     my $sectionNum = 0;
       
   201 
       
   202     foreach my $l (<F>) {
       
   203         if( $l =~ /^#\s*\*\*\s*([A-Z]+)\s*(.*?)\s*\*\*\s*$/ ) {
       
   204             pusht(\@settings, $open) if $open;
       
   205             $open = new TWiki::Configure::Value(typename=>$1, opts=>$2);
       
   206         }
       
   207 
       
   208         elsif ($l =~ /^#?\s*\$(TWiki::)?cfg([^=\s]*)\s*=/) {
       
   209             my $keys = $2;
       
   210             if ($open && $open->isa('SectionMarker')) {
       
   211                 pusht(\@settings, $open);
       
   212                 $open = undef;
       
   213             }
       
   214             # If there is already a UI object for
       
   215             # these keys, we don't need to add another. But if there
       
   216             # isn't, we do.
       
   217             if (!$open) {
       
   218                 next if $root->getValueObject($keys);
       
   219                 next if (_getValueObject($keys, \@settings));
       
   220                 # This is an untyped value
       
   221                 $open = new TWiki::Configure::Value();
       
   222             }
       
   223             $open->set(keys => $keys);
       
   224             pusht(\@settings, $open);
       
   225             $open = undef;
       
   226         }
       
   227 
       
   228         elsif( $l =~ /^#\s*\*([A-Z]+)\*/ ) {
       
   229             my $pluggable = $1;
       
   230             my $p = TWiki::Configure::Pluggable::load($pluggable);
       
   231             if ($p) {
       
   232                 pusht(\@settings, $open) if $open;
       
   233                 $open = $p;
       
   234             } elsif ($open) {
       
   235                 $l =~ s/^#\s?//;
       
   236                 $open->addToDesc($l);
       
   237             }
       
   238         }
       
   239 
       
   240         elsif( $l =~ /^#\s*---\+(\+*) *(.*?)$/ ) {
       
   241             # Only load the first section if we don't have LocalSite.cfg
       
   242             last if ($sectionNum && !$haveLSC);
       
   243             $sectionNum++;
       
   244             pusht(\@settings, $open) if $open;
       
   245             $open = new SectionMarker(length($1), $2);
       
   246         }
       
   247 
       
   248         elsif( $l =~ /^#\s?(.*)$/ ) {
       
   249             $open->addToDesc($1) if $open;
       
   250         }
       
   251     }
       
   252     close(F);
       
   253     pusht(\@settings, $open) if $open;
       
   254     _extractSections(\@settings, $root);
       
   255 }
       
   256 
       
   257 sub pusht {
       
   258     my ($a, $n) = @_;
       
   259     foreach my $v (@$a) {
       
   260         Carp::confess "$n" if $v eq $n;
       
   261     }
       
   262     push(@$a,$n);
       
   263 }
       
   264 
       
   265 ###########################################################################
       
   266 ## OUTPUT
       
   267 ###########################################################################
       
   268 
       
   269 # Generate .cfg file format output
       
   270 sub save {
       
   271     my ($root, $valuer, $logger) = @_;
       
   272 
       
   273     # Object used to act as a visitor to hold the output
       
   274     my $this = new TWiki::Configure::TWikiCfg();
       
   275     $this->{logger} = $logger;
       
   276     $this->{valuer} = $valuer;
       
   277     $this->{root} = $root;
       
   278     $this->{content} = '';
       
   279 
       
   280     my $lsc = TWiki::findFileOnPath('LocalSite.cfg');
       
   281     unless ($lsc) {
       
   282         # If not found on the path, park it beside TWiki.spec
       
   283         $lsc = TWiki::findFileOnPath('TWiki.spec') || '';
       
   284         $lsc =~ s/TWiki\.spec/LocalSite.cfg/;
       
   285     }
       
   286 
       
   287     if (open(F, '<'.$lsc)) {
       
   288         local $/ = undef;
       
   289         $this->{content} = <F>;
       
   290         close(F);
       
   291     } else {
       
   292         $this->{content} = <<'HERE';
       
   293 # Local site settings for TWiki. This file is managed by the 'configure'
       
   294 # CGI script, though you can also make (careful!) manual changes with a
       
   295 # text editor.
       
   296 HERE
       
   297     }
       
   298 
       
   299     my $out = $this->_save();
       
   300     open(F, '>'.$lsc) ||
       
   301       die "Could not open $lsc for write: $!";
       
   302     print F $this->{content};
       
   303     close(F);
       
   304 
       
   305     return '';
       
   306 }
       
   307 
       
   308 sub _save {
       
   309     my $this = shift;
       
   310 
       
   311     $this->{content} =~ s/\s*1;\s*$/\n/sg;
       
   312     $this->{root}->visit($this);
       
   313     $this->{content} .= "1;\n";
       
   314 }
       
   315 
       
   316 # Visitor method called by node traversal during save. Incrementally modify
       
   317 # values, unless a value is reverting to the default in which case remove it.
       
   318 sub startVisit {
       
   319     my ($this, $visitee) = @_;
       
   320 
       
   321     if ($visitee->isa('TWiki::Configure::Value')) {
       
   322         my $keys = $visitee->getKeys();
       
   323         my $warble = $this->{valuer}->currentValue($visitee);
       
   324         return 1 unless defined $warble;
       
   325         my $txt = Data::Dumper->Dump([$warble],
       
   326                                      ['$TWiki::cfg'.$keys]);
       
   327         if ($this->{logger}) {
       
   328             $this->{logger}->logChange($visitee->getKeys(), $txt);
       
   329         }
       
   330         # Substitute any existing value, or append if not there
       
   331         unless ($this->{content} =~ s/\$(TWiki::)?cfg$keys\s*=.*?;\n/$txt/s) {
       
   332             $this->{content} .= $txt;
       
   333         }
       
   334     }
       
   335     return 1;
       
   336 }
       
   337 
       
   338 sub endVisit {
       
   339     my ($this, $visitee) = @_;
       
   340 
       
   341     return 1;
       
   342 }
       
   343 
       
   344 1;