ext/Module-Build/scripts/config_data

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