Commit | Line | Data |
53fc1c7e |
1 | #!/opt/perl/5.10.1/bin/perl |
2 | |
3 | eval 'exec /opt/perl/5.10.1/bin/perl -S $0 ${1+"$@"}' |
4 | if 0; # not running under some shell |
bb4e9162 |
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'"; |
53fc1c7e |
98 | |
bb4e9162 |
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"; |
53fc1c7e |
110 | |
bb4e9162 |
111 | foreach my $name (sort keys %defs) { |
112 | $out .= " --$name"; |
53fc1c7e |
113 | |
bb4e9162 |
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 |
53fc1c7e |
150 | |
bb4e9162 |
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 |
53fc1c7e |
154 | |
bb4e9162 |
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 |