modules/config.pl

   1 # Copyright (C) 2006  Alex Schroeder <alex@emacswiki.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the
  15 #    Free Software Foundation, Inc.
  16 #    59 Temple Place, Suite 330
  17 #    Boston, MA 02111-1307 USA
  18
  19 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/config.pl">config.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Plans">Plans</a></p>';
  20
  21 $Action{config} = \&DoConfig;
  22 $Action{clone} = \&DoClone;
  23
  24 sub DoConfig {
  25   print GetHttpHeader('text/plain') . qq{# Wiki Config
  26 # Source Wiki: $SiteName <$ScriptName>
  27 # } . TimeToText($Now) . qq{
  28 \$AdminPass = "";
  29 \$EditPass = "";
  30 };
  31   my $source = GetRaw('http://www.emacswiki.org/scripts/current');
  32   foreach my $var qw($HomePage $MaxPost $StyleSheet $StyleSheetPage $NotFoundPg
  33                      $NewText $NewComment $EditAllowed $BannedHosts
  34                      $BannedCanRead $BannedContent $WikiLinks $FreeLinks
  35                      $BracketText $BracketWiki $NetworkFile $AllNetworkFiles
  36                      $PermanentAnchors $InterMap $NearMap $RssInterwikiTranslate
  37                      $SurgeProtection $SurgeProtectionTime $SurgeProtectionViews
  38                      $DeletedPage $RCName @RcDays $RcDefault $KeepDays
  39                      $KeepMajor $SummaryHours $SummaryDefaultLength $ShowEdits
  40                      $UseLookup $RecentTop $RecentLink $PageCluster
  41                      $InterWikiMoniker $SiteDescription $RssImageUrl $RssRights
  42                      $RssExclude $RssCacheHours $RssStyleSheet $UploadAllowed
  43                      @UploadTypes $EmbedWiki $FooterNote $EditNote $TopLinkBar
  44                      @UserGotoBarPages $UserGotoBar $ValidatorLink
  45                      $CommentsPrefix $HtmlHeaders $IndentLimit $LanguageLimit
  46                      $JournalLimit $SisterSiteLogoUrl %SpecialDays %Smilies
  47                      %Languages) {
  48     my $default = undef;
  49     my $re = quotemeta($var);
  50     if ($source =~ m!\n$re\s*=\s*(\d+(\s*[*+-/]\s*\d+)*|'[^']*'|"[^"]*"|\(.*?\)|qw\(.*?\))\s*;!) {
  51       $default = $1;
  52     }
  53     $type = substr($var, 0, 1);
  54     if ($type eq '$') {
  55       my $val = eval($var);
  56       print "$var = " . ConfigStr($val) . "; # default: $default\n"
  57         if $val ne eval($default);
  58     } elsif ($type eq '@') {
  59       my @list = eval($var);
  60       my @default = eval($default);
  61       print "$var = (", join(', ', map { ConfigStr($_) } @list)
  62         . "); # default: $default\n"
  63         unless ConfigListEqual(\@list, \@default);
  64     } elsif ($type eq '%') {
  65       my %hash = eval($var);
  66       my @default = eval($default);
  67       print "$var = (", join(', ', map { ConfigStr($_)
  68                                            . ' => ' . ConfigStr($hash{$_})}
  69                              keys %hash) . "); # default: $default\n"
  70         unless ConfigHashEqual(\%hash, \%default);;
  71     }
  72   }
  73   print "# Done!\n";
  74 }
  75
  76 sub ConfigStr {
  77   $_ = shift;
  78   if (m/^\d+$/) {
  79     $_;
  80   } elsif (m/'/) {
  81     "q{$_}";
  82   } else {
  83     "'$_'";
  84   }
  85 }
  86
  87 sub ConfigListEqual {
  88   my ($a, $b) = @_;
  89   return 0 if @$a != @$b;
  90   for ($i = 0; $i < @$a; $i++) {
  91     return 0 unless @$a[$i] eq @$b[$i];
  92   }
  93   return 1;
  94 }
  95
  96 sub ConfigHashEqual {
  97   my ($a, $b) = @_;
  98   return 0 unless ConfigListEqual([keys %$a], [keys %$b]);
  99   foreach my $key (keys %$a) {
 100     next if $$a{$key} eq $$b{$key};
 101     return 0;
 102   }
 103   return 1;
 104 }