lib/Configuration.pm

   1 # -*- Mode: perl; indent-tabs-mode: nil -*-
   2 #
   3 # The contents of this file are subject to the Mozilla Public
   4 # License Version 1.1 (the "License"); you may not use this file
   5 # except in compliance with the License. You may obtain a copy of
   6 # the License at http://www.mozilla.org/MPL/
   7 #
   8 # Software distributed under the License is distributed on an "AS
   9 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  10 # implied. See the License for the specific language governing
  11 # rights and limitations under the License.
  12 #
  13 # The Original Code is the Bugzilla Bug Tracking System.
  14 #
  15 # The Initial Developer of the Original Code is Netscape Communications
  16 # Corporation. Portions created by Netscape are
  17 # Copyright (C) 1998 Netscape Communications Corporation. All
  18 # Rights Reserved.
  19 #
  20 # Contributor(s): Harrison Page <harrison@netscape.com>
  21 #                 Terry Weissman <terry@mozilla.org>
  22 #                 Ian Hickson <py8ieh=mozbot@bath.ac.uk>
  23
  24 package Configuration;
  25 use strict;
  26 use Carp;
  27
  28 sub Get {
  29     my ($file, $config) = @_;
  30     my %seen;
  31     open FILE, "<$file" or return 0;
  32     my $line = 0;
  33     while (<FILE>) {
  34         $line++; chomp;
  35         if (/^ *([^#;][^=\n\r]*)(?:=(.*))?$/os) {
  36             my $value = $$config{$1};
  37             if (defined($value)) {
  38                 $value = $$value while ref($value) eq 'REF';
  39                 if (ref($value) eq 'SCALAR') {
  40                     $$value = $2;
  41                 } elsif (ref($value) eq 'ARRAY') {
  42                     unless ($seen{$1}) {
  43                         @$value = ();
  44                     }
  45                     if (defined($2)) {
  46                         push(@$value, $2);
  47                     }
  48                 } elsif (ref($value) eq 'HASH') {
  49                     unless ($seen{$1}) {
  50                         %$value = ();
  51                     }
  52                     if (defined($2)) {
  53                         $2 =~ /^(.)(.*?)\1=>(.*)$/so;
  54                         $$value{$2} = $3;
  55                     }
  56                 }
  57             } # else unknown variable, ignore
  58             $seen{$1} = 1;
  59         } # else ignore (probably comment)
  60     }
  61     close FILE;
  62     return $line;
  63 }
  64
  65 sub Save {
  66     my ($file, $config) = @_;
  67     local $_;
  68
  69     # Try to keep file structure if possible
  70     my @lines;
  71     if (open FILE, "<$file") {
  72         while (<FILE>) {
  73            push @lines, $_;
  74         }
  75         close FILE;
  76     }
  77
  78     # but make sure we put in all the data (dups are dealt with)
  79     foreach (sort keys %$config) {
  80         push @lines, "$_=";
  81     }
  82
  83     # Open file to which we are saving
  84     open FILE, ">$file.~$$~" or confess("Could not save configuration: $!");
  85
  86     # ok, save file back again
  87     # make sure we only write parameters once by
  88     # keeping a log of those done
  89     my %seen;
  90     foreach (@lines) {
  91         chomp;
  92         if (/^ *([^#;][^=\n\r]*)(?:=(.*))?$/os) {
  93             my $variable = $1;
  94             my $value = $2;
  95             if (defined($$config{$variable})) {
  96                 unless ($seen{$variable}) {
  97                     $value = $$config{$variable};
  98                     $value = $$value while ref($value) eq 'REF';
  99                     if (ref($value) eq 'SCALAR') {
 100                         if (defined($$value)) {
 101                             print FILE $variable.'='.$$value."\n" or confess("Could not save configuration: $!");
 102                         }
 103                     } elsif (ref($value) eq 'HASH') {
 104                         my @keys = keys %$value;
 105                         if (@keys > 0) {
 106                             foreach my $item (@keys) {
 107                                 my $data = $$value{$item};
 108                                 $item = '' unless defined $item;
 109                                 $data = '' unless defined $data;
 110                                 my $delimiter;
 111                                 foreach ('"','\'','|',':','#','*','<','>','/','[',']','{','}',
 112                                          '(',')','\\','=','-','@','!','\$','%','&',' ','\`','~') {
 113                                     if ($item !~ /\Q$_\E=>/os) {
 114                                         $delimiter = $_;
 115                                         last;
 116                                     }
 117                                 }
 118                                 if (defined($delimiter)) {
 119                                   print FILE "$variable=$delimiter$item$delimiter=>$data\n"
 120                                     or confess("Could not save configuration: $!");
 121                                 }
 122                                 # else, silent data loss... XXX
 123                             }
 124                         } else {
 125                             print FILE "$variable\n" or confess("Could not save configuration: $!");
 126                         }
 127                     } elsif (ref($value) eq 'ARRAY') {
 128                         if (@$value > 0) {
 129                             foreach my $item (@$value) {
 130                                 if (defined($item)) {
 131                                     print FILE "$variable=$item\n" or confess("Could not save configuration: $!");
 132                                 } else {
 133                                     print FILE "$variable=\n" or confess("Could not save configuration: $!");
 134                                 }
 135                             }
 136                         } else {
 137                             print FILE "$variable\n" or confess("Could not save configuration: $!");
 138                         }
 139                     } else {
 140                         confess("Unsupported data type '".ref($value)."' writing $variable (".$$config{$variable}.')');
 141                     }
 142                     $seen{$variable} = 1;
 143                 } # else seen it already
 144             } else { # unknown
 145                 if (defined($value)) {
 146                     print FILE "$variable=$value\n" or confess("Could not save configuration: $!");
 147                 } else {
 148                     print FILE "$variable\n" or confess("Could not save configuration: $!");
 149                 }
 150             }
 151         } else {
 152             # might be a comment
 153             print FILE $_."\n" or confess("Could not save configuration: $!");
 154         }
 155     }
 156     # actually do make a change to the real file
 157     close FILE or confess("Could not save configuration: $!");
 158
 159     # -- #mozwebtools was here --
 160     # * Hixie is sad as his bot crashes.
 161     # * Hixie adds in a check to make sure that the file he tries
 162     #   to delete actually exists first.
 163     # <timeless>   delete??
 164
 165     unlink $file or confess("Could not delete $file: $!") if (-e $file);
 166     rename("$file.~$$~", $file) or confess("Could not rename to $file: $!");
 167 }
 168
 169 sub Ensure {
 170     my ($config) = @_;
 171     my $changed;
 172     foreach (@$config) {
 173         if (ref($$_[1]) eq 'SCALAR') {
 174             unless (defined(${$$_[1]})) {
 175                 if (-t) {
 176                     print $$_[0]. ' ';
 177                     <> =~ /^(.*)$/os;
 178                     ${$$_[1]} = $1;
 179                     ${$$_[1]} = '' unless defined ${$$_[1]};
 180                     chomp(${$$_[1]});
 181                     $changed++;
 182                 } else {
 183                     confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
 184                 }
 185             }
 186         } elsif (ref($$_[1]) eq 'ARRAY') {
 187             unless (defined(@{$$_[1]})) {
 188                 if (-t) {
 189                     print $$_[0]. " (enter a blank line to finish)\n";
 190                     my $input;
 191                     do {
 192                         $input = <>;
 193                         $input = '' unless defined $input;
 194                         chomp($input);
 195                         push @{$$_[1]}, $input if $input;
 196                         $changed++;
 197                     } while $input;
 198                 } else {
 199                     confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
 200                 }
 201             }
 202         } else {
 203             confess("Unsupported data type expected for question '$$_[0]'");
 204         }
 205     }
 206     return $changed;
 207 }
 208
 209 1; # end