This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
76956bcbc29b60f8b29fc0b79e7d655dfdcffa0f
[perl5.git] / lib / Module / Build / ConfigData.pm
1 package Module::Build::ConfigData;
2 use strict;
3 my $arrayref = eval do {local $/; <DATA>}
4   or die "Couldn't load ConfigData data: $@";
5 close DATA;
6 my ($config, $features, $auto_features) = @$arrayref;
7
8 sub config { $config->{$_[1]} }
9
10 sub set_config { $config->{$_[1]} = $_[2] }
11 sub set_feature { $features->{$_[1]} = 0+!!$_[2] }  # Constrain to 1 or 0
12
13 sub auto_feature_names { grep !exists $features->{$_}, keys %$auto_features }
14
15 sub feature_names {
16   my @features = (keys %$features, auto_feature_names());
17   @features;
18 }
19
20 sub config_names  { keys %$config }
21
22 sub write {
23   my $me = __FILE__;
24   require IO::File;
25
26   # Can't use Module::Build::Dumper here because M::B is only a
27   # build-time prereq of this module
28   require Data::Dumper;
29
30   my $mode_orig = (stat $me)[2] & 07777;
31   chmod($mode_orig | 0222, $me); # Make it writeable
32   my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
33   seek($fh, 0, 0);
34   while (<$fh>) {
35     last if /^__DATA__$/;
36   }
37   die "Couldn't find __DATA__ token in $me" if eof($fh);
38
39   seek($fh, tell($fh), 0);
40   my $data = [$config, $features, $auto_features];
41   $fh->print( 'do{ my '
42               . Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
43               . '$x; }' );
44   truncate($fh, tell($fh));
45   $fh->close;
46
47   chmod($mode_orig, $me)
48     or warn "Couldn't restore permissions on $me: $!";
49 }
50
51 sub feature {
52   my ($package, $key) = @_;
53   return $features->{$key} if exists $features->{$key};
54   
55   my $info = $auto_features->{$key} or return 0;
56   
57   # Under perl 5.005, each(%$foo) isn't working correctly when $foo
58   # was reanimated with Data::Dumper and eval().  Not sure why, but
59   # copying to a new hash seems to solve it.
60   my %info = %$info;
61   
62   require Module::Build;  # XXX should get rid of this
63   while (my ($type, $prereqs) = each %info) {
64     next if $type eq 'description' || $type eq 'recommends';
65     
66     my %p = %$prereqs;  # Ditto here.
67     while (my ($modname, $spec) = each %p) {
68       my $status = Module::Build->check_installed_status($modname, $spec);
69       if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
70       if ( ! eval "require $modname; 1" ) { return 0; }
71     }
72   }
73   return 1;
74 }
75
76
77 =head1 NAME
78
79 Module::Build::ConfigData - Configuration for Module::Build
80
81
82 =head1 SYNOPSIS
83
84   use Module::Build::ConfigData;
85   $value = Module::Build::ConfigData->config('foo');
86   $value = Module::Build::ConfigData->feature('bar');
87   
88   @names = Module::Build::ConfigData->config_names;
89   @names = Module::Build::ConfigData->feature_names;
90   
91   Module::Build::ConfigData->set_config(foo => $new_value);
92   Module::Build::ConfigData->set_feature(bar => $new_value);
93   Module::Build::ConfigData->write;  # Save changes
94
95
96 =head1 DESCRIPTION
97
98 This module holds the configuration data for the C<Module::Build>
99 module.  It also provides a programmatic interface for getting or
100 setting that configuration data.  Note that in order to actually make
101 changes, you'll have to have write access to the C<Module::Build::ConfigData>
102 module, and you should attempt to understand the repercussions of your
103 actions.
104
105
106 =head1 METHODS
107
108 =over 4
109
110 =item config($name)
111
112 Given a string argument, returns the value of the configuration item
113 by that name, or C<undef> if no such item exists.
114
115 =item feature($name)
116
117 Given a string argument, returns the value of the feature by that
118 name, or C<undef> if no such feature exists.
119
120 =item set_config($name, $value)
121
122 Sets the configuration item with the given name to the given value.
123 The value may be any Perl scalar that will serialize correctly using
124 C<Data::Dumper>.  This includes references, objects (usually), and
125 complex data structures.  It probably does not include transient
126 things like filehandles or sockets.
127
128 =item set_feature($name, $value)
129
130 Sets the feature with the given name to the given boolean value.  The
131 value will be converted to 0 or 1 automatically.
132
133 =item config_names()
134
135 Returns a list of all the names of config items currently defined in
136 C<Module::Build::ConfigData>, or in scalar context the number of items.
137
138 =item feature_names()
139
140 Returns a list of all the names of features currently defined in
141 C<Module::Build::ConfigData>, or in scalar context the number of features.
142
143 =item auto_feature_names()
144
145 Returns a list of all the names of features whose availability is
146 dynamically determined, or in scalar context the number of such
147 features.  Does not include such features that have later been set to
148 a fixed value.
149
150 =item write()
151
152 Commits any changes from C<set_config()> and C<set_feature()> to disk.
153 Requires write access to the C<Module::Build::ConfigData> module.
154
155 =back
156
157
158 =head1 AUTHOR
159
160 C<Module::Build::ConfigData> was automatically created using C<Module::Build>.
161 C<Module::Build> was written by Ken Williams, but he holds no
162 authorship claim or copyright claim to the contents of C<Module::Build::ConfigData>.
163
164 =cut
165
166 __DATA__
167
168 do{ my $x = [
169        {},
170        {},
171        {
172          'YAML_support' => {
173                              'requires' => {
174                                              'YAML' => ' >= 0.35, != 0.49_01 '
175                                            },
176                              'description' => 'Use YAML.pm to write META.yml files'
177                            },
178          'manpage_support' => {
179                                 'requires' => {
180                                                 'Pod::Man' => 0
181                                               },
182                                 'description' => 'Create Unix man pages'
183                               },
184          'C_support' => {
185                           'requires' => {
186                                           'ExtUtils::CBuilder' => '0.15'
187                                         },
188                           'recommends' => {
189                                             'ExtUtils::ParseXS' => '1.02'
190                                           },
191                           'description' => 'Compile/link C & XS code'
192                         },
193          'HTML_support' => {
194                              'requires' => {
195                                              'Pod::Html' => 0
196                                            },
197                              'description' => 'Create HTML documentation'
198                            }
199        }
200      ];
201 $x; }