local-lib5/bin/config_data

   1 #!/usr/bin/perl
   2
   3 eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
   4     if 0; # not running under some shell
   5
   6 use strict;
   7 use Module::Build 0.25;
   8 use Getopt::Long;
   9
  10 my %opt_defs = (
  11                 module      => {type => '=s',
  12                                 desc => 'The name of the module to configure (required)'},
  13                 feature     => {type => ':s',
  14                                 desc => 'Print the value of a feature or all features'},
  15                 config      => {type => ':s',
  16                                 desc => 'Print the value of a config option'},
  17                 set_feature => {type => '=s%',
  18                                 desc => "Set a feature to 'true' or 'false'"},
  19                 set_config  => {type => '=s%',
  20                                 desc => 'Set a config option to the given value'},
  21                 eval        => {type => '',
  22                                 desc => 'eval() config values before setting'},
  23                 help        => {type => '',
  24                                 desc => 'Print a help message and exit'},
  25                );
  26
  27 my %opts;
  28 GetOptions( \%opts, map "$_$opt_defs{$_}{type}", keys %opt_defs ) or die usage(%opt_defs);
  29 print usage(%opt_defs) and exit(0)
  30   if $opts{help};
  31
  32 my @exclusive = qw(feature config set_feature set_config);
  33 die "Exactly one of the options '" . join("', '", @exclusive) . "' must be specified\n" . usage(%opt_defs)
  34   unless grep(exists $opts{$_}, @exclusive) == 1;
  35
  36 die "Option --module is required\n" . usage(%opt_defs)
  37   unless $opts{module};
  38
  39 my $cf = load_config($opts{module});
  40
  41 if (exists $opts{feature}) {
  42
  43   if (length $opts{feature}) {
  44     print $cf->feature($opts{feature});
  45   } else {
  46     my %auto;
  47     # note: need to support older ConfigData.pm's
  48     @auto{$cf->auto_feature_names} = () if $cf->can("auto_feature_names");
  49
  50     print " Features defined in $cf:\n";
  51     foreach my $name (sort $cf->feature_names) {
  52       print "  $name => ", $cf->feature($name), (exists $auto{$name} ? " (dynamic)" : ""), "\n";
  53     }
  54   }
  55
  56 } elsif (exists $opts{config}) {
  57
  58   require Data::Dumper;
  59   local $Data::Dumper::Terse = 1;
  60
  61   if (length $opts{config}) {
  62     print Data::Dumper::Dumper($cf->config($opts{config})), "\n";
  63   } else {
  64     print " Configuration defined in $cf:\n";
  65     foreach my $name (sort $cf->config_names) {
  66       print "  $name => ", Data::Dumper::Dumper($cf->config($name)), "\n";
  67     }
  68   }
  69
  70 } elsif (exists $opts{set_feature}) {
  71   my %to_set = %{$opts{set_feature}};
  72   while (my ($k, $v) = each %to_set) {
  73     die "Feature value must be 0 or 1\n" unless $v =~ /^[01]$/;
  74     $cf->set_feature($k, 0+$v); # Cast to a number, not a string
  75   }
  76   $cf->write;
  77   print "Feature" . 's'x(keys(%to_set)>1) . " saved\n";
  78
  79 } elsif (exists $opts{set_config}) {
  80
  81   my %to_set = %{$opts{set_config}};
  82   while (my ($k, $v) = each %to_set) {
  83     if ($opts{eval}) {
  84       $v = eval($v);
  85       die $@ if $@;
  86     }
  87     $cf->set_config($k, $v);
  88   }
  89   $cf->write;
  90   print "Config value" . 's'x(keys(%to_set)>1) . " saved\n";
  91 }
  92
  93 sub load_config {
  94   my $mod = shift;
  95
  96   $mod =~ /^([\w:]+)$/
  97     or die "Invalid module name '$mod'";
  98
  99   my $cf = $mod . "::ConfigData";
 100   eval "require $cf";
 101   die $@ if $@;
 102
 103   return $cf;
 104 }
 105
 106 sub usage {
 107   my %defs = @_;
 108
 109   my $out = "\nUsage: $0 [options]\n\n  Options include:\n";
 110
 111   foreach my $name (sort keys %defs) {
 112     $out .= "  --$name";
 113
 114     for ($defs{$name}{type}) {
 115       /^=s$/  and      $out .= " <string>";
 116       /^=s%$/ and      $out .= " <string>=<value>";
 117     }
 118
 119     pad_line($out, 35);
 120     $out .= "$defs{$name}{desc}\n";
 121   }
 122
 123   $out .= <<EOF;
 124
 125   Examples:
 126    $0 --module Foo::Bar --feature bazzable
 127    $0 --module Foo::Bar --config magic_number
 128    $0 --module Foo::Bar --set_feature bazzable=1
 129    $0 --module Foo::Bar --set_config magic_number=42
 130
 131 EOF
 132
 133   return $out;
 134 }
 135
 136 sub pad_line {  $_[0] .= ' ' x ($_[1] - length($_[0]) + rindex($_[0], "\n")) }
 137
 138
 139 __END__
 140
 141 =head1 NAME
 142
 143 config_data - Query or change configuration of Perl modules
 144
 145 =head1 SYNOPSIS
 146
 147   # Get config/feature values
 148   config_data --module Foo::Bar --feature bazzable
 149   config_data --module Foo::Bar --config magic_number
 150
 151   # Set config/feature values
 152   config_data --module Foo::Bar --set_feature bazzable=1
 153   config_data --module Foo::Bar --set_config magic_number=42
 154
 155   # Print a usage message
 156   config_data --help
 157
 158 =head1 DESCRIPTION
 159
 160 The C<config_data> tool provides a command-line interface to the
 161 configuration of Perl modules.  By "configuration", we mean something
 162 akin to "user preferences" or "local settings".  This is a
 163 formalization and abstraction of the systems that people like Andreas
 164 Koenig (C<CPAN::Config>), Jon Swartz (C<HTML::Mason::Config>), Andy
 165 Wardley (C<Template::Config>), and Larry Wall (perl's own Config.pm)
 166 have developed independently.
 167
 168 The configuration system emplyed here was developed in the context of
 169 C<Module::Build>.  Under this system, configuration information for a
 170 module C<Foo>, for example, is stored in a module called
 171 C<Foo::ConfigData>) (I would have called it C<Foo::Config>, but that
 172 was taken by all those other systems mentioned in the previous
 173 paragraph...).  These C<...::ConfigData> modules contain the
 174 configuration data, as well as publically accessible methods for
 175 querying and setting (yes, actually re-writing) the configuration
 176 data.  The C<config_data> script (whose docs you are currently
 177 reading) is merely a front-end for those methods.  If you wish, you
 178 may create alternate front-ends.
 179
 180 The two types of data that may be stored are called C<config> values
 181 and C<feature> values.  A C<config> value may be any perl scalar,
 182 including references to complex data structures.  It must, however, be
 183 serializable using C<Data::Dumper>.  A C<feature> is a boolean (1 or
 184 0) value.
 185
 186 =head1 USAGE
 187
 188 This script functions as a basic getter/setter wrapper around the
 189 configuration of a single module.  On the command line, specify which
 190 module's configuration you're interested in, and pass options to get
 191 or set C<config> or C<feature> values.  The following options are
 192 supported:
 193
 194 =over 4
 195
 196 =item module
 197
 198 Specifies the name of the module to configure (required).
 199
 200 =item feature
 201
 202 When passed the name of a C<feature>, shows its value.  The value will
 203 be 1 if the feature is enabled, 0 if the feature is not enabled, or
 204 empty if the feature is unknown.  When no feature name is supplied,
 205 the names and values of all known features will be shown.
 206
 207 =item config
 208
 209 When passed the name of a C<config> entry, shows its value.  The value
 210 will be displayed using C<Data::Dumper> (or similar) as perl code.
 211 When no config name is supplied, the names and values of all known
 212 config entries will be shown.
 213
 214 =item set_feature
 215
 216 Sets the given C<feature> to the given boolean value.  Specify the value
 217 as either 1 or 0.
 218
 219 =item set_config
 220
 221 Sets the given C<config> entry to the given value.
 222
 223 =item eval
 224
 225 If the C<--eval> option is used, the values in C<set_config> will be
 226 evaluated as perl code before being stored.  This allows moderately
 227 complicated data structures to be stored.  For really complicated
 228 structures, you probably shouldn't use this command-line interface,
 229 just use the Perl API instead.
 230
 231 =item help
 232
 233 Prints a help message, including a few examples, and exits.
 234
 235 =back
 236
 237 =head1 AUTHOR
 238
 239 Ken Williams, kwilliams@cpan.org
 240
 241 =head1 COPYRIGHT
 242
 243 Copyright (c) 1999, Ken Williams.  All rights reserved.
 244
 245 This library is free software; you can redistribute it and/or modify
 246 it under the same terms as Perl itself.
 247
 248 =head1 SEE ALSO
 249
 250 Module::Build(3), perl(1).
 251
 252 =cut