Changeset 323:2fb49308319a

Timestamp:

08/21/11 02:44:03 (9 months ago)

Author:

Anselm Lingnau <anselm@…>

Branch:

default

Message:

Configuration parameter system reworked.
This adds a list of ?official? configuration parameters together with their
types, default values, and explanatory messages. An extended method,
DB::get_config_x(), is used to retrieve all of this info, and DB::get_config()
is changed to return the default value from the list if the parameter is not
set in the database.

In the pl-conf command, there are some new --query suboptions: --all outputs
all configuration parameters, not just those that are in the current list
database; --modified outputs only those parameters whose values differ from
the built-in defaults; and --defaults outputs the built-in default values
of parameters rather than their actual values.

This change is really for the benefit of Project Guinevere, which needs to
be able to produce a list configuration page containing all possible parameters
rather than just the ones that happen to be in the database at that point.
We will still have to go through the files and adapt all the calls to
get_config() to remove the hard-coded defaults, and we can also get rid of the
big default parameter list in DB.pm.

Files:

• MANIFEST (modified) (1 diff)
• bin/pl-conf (modified) (7 diffs)
• lib/Lancelot/ConfigItems.pm (added)
• lib/Lancelot/DB.pm (modified) (4 diffs)

MANIFEST

@@ -36 +36 @@
 lib/Lancelot/Bounce/tonline.pm
 lib/Lancelot/Bounce/yahoo.pm
+lib/Lancelot/ConfigItems.pm
 lib/Lancelot/DB.pm
 lib/Lancelot/GetOpt.pm

bin/pl-conf

@@ -7 +7 @@
 =head1 SYNOPSIS
 
-  pl-conf [--query|-q] [--valueonly|-h] list@domain [parameter ...]
+  pl-conf [--query|-q] [--all|-A] [--modified|-M] [--defaults|-D]
+            [--valueonly|-h] list@domain [parameter ...]
   pl-conf [--set|-s] list@domain ["parameter = value" ...]
   pl-conf [--import|-i] [--onlynew|-n] list@domain [file ...]
@@ -27 +28 @@
 
 With the B<--query> (or B<-q>) option, B<pl-conf> will print either
-all of the configuration parameters (if no parameter names are given)
-or the specified parameters to standard output, like
+all of the configuration parameters in the database (if no parameter
+names are given) or the specified parameters to standard output, like
 
   list.address = test@example.com
@@ -42 +43 @@
 line.  This is convenient if the parameter value is to be used, e.g.,
 in a shell script.
+
+With the B<--modified> (or B<-M>) option, B<--query> only lists those
+parameters whose values differ from their built-in defaults. With the
+B<--defaults> (or B<-D>) option, the built-in default values of
+parameters are displayed instead of their actual values. With the
+B<--all> (or B<-A>) option, all parameters known to Project Lancelot
+are displayed, not just those that actually occur in the database of
+the list being considered.
 
 The output of B<pl-conf --query> is suitable as input for
@@ -142 +151 @@
 Introduces a command-line alias for a mailing list.
 
+=item B<--all>, B<-A>
+
+With B<--query>, outputs all configuration parameters known to Project
+Lancelot, not just those that actually occur in the database of the
+current list.
+
+=item B<--defaults>, B<-D>
+
+With B<--query>, causes the program to output the built-in default values
+of parameters rather than their actual values.
+
 =item B<--delete>, B<-d>
 
@@ -162 +182 @@
 this specifies the list that the given list's database should be merged
 into.
+
+=item B<--modified>, B<-M>
+
+With B<--query>, outputs only those parameter whose values differ from
+their built-in default values.
 
 =item B<--onlynew>, B<-n>
@@ -257 +282 @@
 use Lancelot::Log qw/log/;
 
-my (%opts);
+my %opts = ( all => 0 );
 
 GetOptions(\%opts, -defaults, -argvmin => 1, "no list address specified",
            "query|q?", "set|s?", "import|i?", "delete|d?", "valueonly|h?",
            "merge|m?", "unmerge|u?", "alias|a?", "into=",
+           "defaults|D?", "modified|M?", "all|A?",
            "onlynew|n?", "edit|e?", "user|u=");
 
-pod2usage( -message => "$0: need one of --query, --set, --import, --delete",
-           -exitvalue => 2)
+pod2usage( -message => "$0: need one of --query, --set, --import, --delete, --merge, --unmerge, --alias",
+           -exitvalue => 2 )
     if $opts{alias} + $opts{query} + $opts{set} + $opts{import}
            + $opts{delete} + $opts{edit} + $opts{merge} + $opts{unmerge} != 1
-        || ($opts{valueonly} && !$opts{query})
+        || (($opts{valueonly} || $opts{defaults} || $opts{modified}
+            || $opts{all}) && !$opts{query})
         || ($opts{onlynew} && !$opts{import})
         || ($opts{into} && !$opts{merge});
@@ -284 +311 @@
             ($pattern = $ARGV[0]) =~ s/\./\\./g; $pattern =~ s/\*/.*/g;
         }
-        @parameters = grep { /$pattern/o } $db->config_names;
+        @parameters = grep { /$pattern/o }
+            $db->config_names({ all => $opts{all} });
         $opts{valueonly} = 0;
     }
     foreach my $p (sort @parameters) {
+        my ($v, $status, $default) = $db->get_config_x($p);
+        next if $opts{modified} && $status < 2; 
+        $v = $default if $opts{defaults};
         print "$p = " unless $opts{valueonly};
-        my ($v) = $db->get_config($p);
         if ($v =~ /^\s+/ || $v =~ /\s+$/) {
             $v =~ s/\"/\\\"/g;

lib/Lancelot/DB.pm

@@ -71 +71 @@
 
 use Lancelot::Log qw/log/;
+use Lancelot::ConfigItems;
 
 # Here are the SQL definitions Project Lancelot uses when initialising a
@@ -383 +384 @@
     my ($local, $domain) = split /\@/, $listaddr;
 
+    Lancelot::ConfigItems::init();
+
     my $home;
     my $user = $optref->{user};
@@ -825 +828 @@
 sub get_config {
     my ($self, $key) = @_;
-    my $value = ($self->{dbh}->selectrow_array("SELECT value FROM config WHERE list_id=? AND key=?",
-                                               {}, $self->{list_id}, $key))[0];
-    return $value;
+    my $config = $self->{dbh}->selectrow_hashref(
+        "SELECT value FROM config WHERE list_id=? AND key=?",
+        {}, $self->{list_id}, $key);
+    if (!$config) {
+        my $cfgvar = Lancelot::ConfigItems->config_item($key);
+        log "warn", "unknown configuration variable $key" unless $cfgvar;
+        return $cfgvar? $cfgvar->{default} : undef;
+    }
+    return $config->{value};
+}
+
+=item C<get_config_x>
+
+  $value = $db->get_config_x($key);
+
+Returns a tuple (C<$value>, C<$status>, C<$default>, C<$type>,
+C<$help>) where C<$value> is the current value of the configuration
+parameter and C<$status> is 0 if the parameter is not set in the
+database (i.e., C<$value> is the internal hard-coded default), 1 if
+the parameter is set in the database but equals the internal
+hard-coded default, 2 if the parameter is set in the database but does
+not I<have> an internal hard-coded default (because it is used by a
+processing module that didn't register it with the internal list), and
+3 if the parameter is set in the database and differs from the
+hard-coded default.
+
+C<$type> is one of BOOL, INT, STR, and SEL and gives the type of value
+that the configuration parameter is supposed to take on.
+
+This is mostly for the benefit of the Project Guinevere web front end,
+but also pl-conf(1).
+
+=cut
+
+sub get_config_x {
+    my ($self, $key) = @_;
+    my $cfgvar = Lancelot::ConfigItems->config_item($key);
+    my $config = $self->{dbh}->selectrow_hashref(
+        "SELECT value FROM config WHERE list_id=? AND key=?",
+        {}, $self->{list_id}, $key);
+    my @result;
+    if (!$config) {
+        if (!$cfgvar) {
+            @result = (undef, 4, undef, undef, undef);
+        } else {
+            @result = ($cfgvar->{default}, 0, $cfgvar->{default},
+                $cfgvar->{type}, $cfgvar->{help});
+        }
+    } elsif (!$cfgvar) {
+        @result = ($config->{value}, 2, undef, undef, undef);
+    } else {
+        if ($config->{value} eq $cfgvar->{default}) {
+            @result = ($config->{value}, 1);
+        } else {
+            @result = ($config->{value}, 3);
+        }
+        push @result, $cfgvar->{default}, $cfgvar->{type}, $cfgvar->{help};
+    }
+    return @result;
 }
 
@@ -952 +1011 @@
 
 sub config_names {
-    my ($self) = @_;
-    my ($ref) = $self->{dbh}->selectcol_arrayref("SELECT key FROM config WHERE list_id=?",
-                                                 {}, $self->{list_id});
-    return @$ref;
+    my ($self, $optref) = @_;
+    my %names = map { $_ => 1 } @{$self->{dbh}->selectcol_arrayref(
+                                      "SELECT key FROM config WHERE list_id=?",
+                                      {}, $self->{list_id})};
+    if ($optref->{all}) {
+        $names{$_} = 1 foreach Lancelot::ConfigItems->config_item_keys();
+    }
+    return keys %names;
 }