This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Module-Build to CPAN version 0.4201
[perl5.git] / cpan / Module-Build / lib / Module / Build / Notes.pm
CommitLineData
bb4e9162
YST
1package Module::Build::Notes;
2
3# A class for persistent hashes
4
5use strict;
7a827510 6use vars qw($VERSION);
d320cf40 7$VERSION = '0.4201';
7a827510 8$VERSION = eval $VERSION;
bb4e9162 9use Data::Dumper;
7a827510 10use Module::Build::Dumper;
bb4e9162 11
bb4e9162
YST
12sub new {
13 my ($class, %args) = @_;
14 my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
15 my $self = bless {
16 disk => {},
17 new => {},
18 file => $file,
19 %args,
20 }, $class;
21}
22
23sub restore {
24 my $self = shift;
25
46de787b 26 open(my $fh, '<', $self->{file}) or die "Can't read $self->{file}: $!";
bb4e9162
YST
27 $self->{disk} = eval do {local $/; <$fh>};
28 die $@ if $@;
46de787b 29 close $fh;
bb4e9162
YST
30 $self->{new} = {};
31}
32
33sub access {
34 my $self = shift;
35 return $self->read() unless @_;
53fc1c7e 36
bb4e9162
YST
37 my $key = shift;
38 return $self->read($key) unless @_;
53fc1c7e 39
bb4e9162
YST
40 my $value = shift;
41 $self->write({ $key => $value });
42 return $self->read($key);
43}
44
45sub has_data {
46 my $self = shift;
47 return keys %{$self->read()} > 0;
48}
49
50sub exists {
51 my ($self, $key) = @_;
52 return exists($self->{new}{$key}) || exists($self->{disk}{$key});
53}
54
55sub read {
56 my $self = shift;
57
58 if (@_) {
59 # Return 1 key as a scalar
60 my $key = shift;
61 return $self->{new}{$key} if exists $self->{new}{$key};
62 return $self->{disk}{$key};
63 }
53fc1c7e 64
bb4e9162
YST
65 # Return all data
66 my $out = (keys %{$self->{new}}
67 ? {%{$self->{disk}}, %{$self->{new}}}
68 : $self->{disk});
69 return wantarray ? %$out : $out;
70}
71
72sub _same {
73 my ($self, $x, $y) = @_;
74 return 1 if !defined($x) and !defined($y);
75 return 0 if !defined($x) or !defined($y);
76 return $x eq $y;
77}
78
79sub write {
80 my ($self, $href) = @_;
81 $href ||= {};
53fc1c7e 82
bb4e9162
YST
83 @{$self->{new}}{ keys %$href } = values %$href; # Merge
84
85 # Do some optimization to avoid unnecessary writes
86 foreach my $key (keys %{ $self->{new} }) {
87 next if ref $self->{new}{$key};
88 next if ref $self->{disk}{$key} or !exists $self->{disk}{$key};
89 delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key});
90 }
53fc1c7e 91
bb4e9162
YST
92 if (my $file = $self->{file}) {
93 my ($vol, $dir, $base) = File::Spec->splitpath($file);
94 $dir = File::Spec->catpath($vol, $dir, '');
95 return unless -e $dir && -d $dir; # The user needs to arrange for this
96
97 return if -e $file and !keys %{ $self->{new} }; # Nothing to do
53fc1c7e
DG
98
99 @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
bb4e9162 100 $self->_dump($file, $self->{disk});
53fc1c7e 101
bb4e9162
YST
102 $self->{new} = {};
103 }
104 return $self->read;
105}
106
107sub _dump {
108 my ($self, $file, $data) = @_;
53fc1c7e 109
46de787b 110 open(my $fh, '>', $file) or die "Can't create '$file': $!";
7a827510 111 print {$fh} Module::Build::Dumper->_data_dump($data);
46de787b 112 close $fh;
bb4e9162
YST
113}
114
613f422f
DG
115my $orig_template = do { local $/; <DATA> };
116close DATA;
117
bb4e9162
YST
118sub write_config_data {
119 my ($self, %args) = @_;
120
613f422f
DG
121 my $template = $orig_template;
122 $template =~ s/NOTES_NAME/$args{config_module}/g;
123 $template =~ s/MODULE_NAME/$args{module}/g;
124 $template =~ s/=begin private\n//;
125 $template =~ s/=end private/=cut/;
126
127 # strip out private POD markers we use to keep pod from being
128 # recognized for *this* source file
129 $template =~ s{$_\n}{} for '=begin private', '=end private';
53fc1c7e 130
46de787b 131 open(my $fh, '>', $args{file}) or die "Can't create '$args{file}': $!";
613f422f
DG
132 print {$fh} $template;
133 print {$fh} "\n__DATA__\n";
134 print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);
46de787b 135 close $fh;
613f422f
DG
136}
137
1381;
139
140
141=head1 NAME
142
143Module::Build::Notes - Create persistent distribution configuration modules
144
145=head1 DESCRIPTION
146
147This module is used internally by Module::Build to create persistent
148configuration files that can be installed with a distribution. See
149L<Module::Build::ConfigData> for an example.
150
151=head1 AUTHOR
bb4e9162 152
613f422f
DG
153Ken Williams <kwilliams@cpan.org>
154
155=head1 COPYRIGHT
156
157Copyright (c) 2001-2006 Ken Williams. All rights reserved.
158
159This library is free software; you can redistribute it and/or
160modify it under the same terms as Perl itself.
161
162=head1 SEE ALSO
163
164perl(1), L<Module::Build>(3)
165
166=cut
167
168__DATA__
169package NOTES_NAME;
bb4e9162
YST
170use strict;
171my $arrayref = eval do {local $/; <DATA>}
172 or die "Couldn't load ConfigData data: $@";
173close DATA;
174my ($config, $features, $auto_features) = @$arrayref;
175
176sub config { $config->{$_[1]} }
177
178sub set_config { $config->{$_[1]} = $_[2] }
179sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
180
613f422f 181sub auto_feature_names { grep !exists $features->{$_}, keys %$auto_features }
bb4e9162
YST
182
183sub feature_names {
613f422f 184 my @features = (keys %$features, auto_feature_names());
bb4e9162
YST
185 @features;
186}
187
613f422f 188sub config_names { keys %$config }
bb4e9162
YST
189
190sub write {
191 my $me = __FILE__;
7a827510
RGS
192
193 # Can't use Module::Build::Dumper here because M::B is only a
194 # build-time prereq of this module
bb4e9162
YST
195 require Data::Dumper;
196
197 my $mode_orig = (stat $me)[2] & 07777;
198 chmod($mode_orig | 0222, $me); # Make it writeable
46de787b 199 open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
bb4e9162
YST
200 seek($fh, 0, 0);
201 while (<$fh>) {
202 last if /^__DATA__$/;
203 }
204 die "Couldn't find __DATA__ token in $me" if eof($fh);
205
bb4e9162 206 seek($fh, tell($fh), 0);
7a827510 207 my $data = [$config, $features, $auto_features];
46de787b 208 print($fh 'do{ my '
7a827510
RGS
209 . Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
210 . '$x; }' );
bb4e9162 211 truncate($fh, tell($fh));
46de787b 212 close $fh;
bb4e9162
YST
213
214 chmod($mode_orig, $me)
215 or warn "Couldn't restore permissions on $me: $!";
216}
217
218sub feature {
219 my ($package, $key) = @_;
220 return $features->{$key} if exists $features->{$key};
53fc1c7e 221
bb4e9162 222 my $info = $auto_features->{$key} or return 0;
53fc1c7e 223
613f422f 224 # Under perl 5.005, each(%$foo) isn't working correctly when $foo
bb4e9162
YST
225 # was reanimated with Data::Dumper and eval(). Not sure why, but
226 # copying to a new hash seems to solve it.
613f422f 227 my %info = %$info;
53fc1c7e 228
bb4e9162 229 require Module::Build; # XXX should get rid of this
613f422f 230 while (my ($type, $prereqs) = each %info) {
bb4e9162 231 next if $type eq 'description' || $type eq 'recommends';
53fc1c7e 232
613f422f
DG
233 my %p = %$prereqs; # Ditto here.
234 while (my ($modname, $spec) = each %p) {
bb4e9162
YST
235 my $status = Module::Build->check_installed_status($modname, $spec);
236 if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
23837600 237 if ( ! eval "require $modname; 1" ) { return 0; }
bb4e9162
YST
238 }
239 }
240 return 1;
241}
242
613f422f 243=begin private
bb4e9162
YST
244
245=head1 NAME
246
613f422f 247NOTES_NAME - Configuration for MODULE_NAME
bb4e9162
YST
248
249=head1 SYNOPSIS
250
613f422f
DG
251 use NOTES_NAME;
252 $value = NOTES_NAME->config('foo');
253 $value = NOTES_NAME->feature('bar');
53fc1c7e 254
613f422f
DG
255 @names = NOTES_NAME->config_names;
256 @names = NOTES_NAME->feature_names;
53fc1c7e 257
613f422f
DG
258 NOTES_NAME->set_config(foo => $new_value);
259 NOTES_NAME->set_feature(bar => $new_value);
260 NOTES_NAME->write; # Save changes
bb4e9162
YST
261
262
263=head1 DESCRIPTION
264
613f422f 265This module holds the configuration data for the C<MODULE_NAME>
bb4e9162
YST
266module. It also provides a programmatic interface for getting or
267setting that configuration data. Note that in order to actually make
613f422f 268changes, you'll have to have write access to the C<NOTES_NAME>
bb4e9162
YST
269module, and you should attempt to understand the repercussions of your
270actions.
271
272
273=head1 METHODS
274
275=over 4
276
613f422f 277=item config($name)
bb4e9162
YST
278
279Given a string argument, returns the value of the configuration item
280by that name, or C<undef> if no such item exists.
281
613f422f 282=item feature($name)
bb4e9162
YST
283
284Given a string argument, returns the value of the feature by that
285name, or C<undef> if no such feature exists.
286
613f422f 287=item set_config($name, $value)
bb4e9162
YST
288
289Sets the configuration item with the given name to the given value.
290The value may be any Perl scalar that will serialize correctly using
291C<Data::Dumper>. This includes references, objects (usually), and
292complex data structures. It probably does not include transient
293things like filehandles or sockets.
294
613f422f 295=item set_feature($name, $value)
bb4e9162
YST
296
297Sets the feature with the given name to the given boolean value. The
298value will be converted to 0 or 1 automatically.
299
300=item config_names()
301
302Returns a list of all the names of config items currently defined in
613f422f 303C<NOTES_NAME>, or in scalar context the number of items.
bb4e9162
YST
304
305=item feature_names()
306
307Returns a list of all the names of features currently defined in
613f422f 308C<NOTES_NAME>, or in scalar context the number of features.
bb4e9162
YST
309
310=item auto_feature_names()
311
312Returns a list of all the names of features whose availability is
313dynamically determined, or in scalar context the number of such
314features. Does not include such features that have later been set to
315a fixed value.
316
317=item write()
318
319Commits any changes from C<set_config()> and C<set_feature()> to disk.
613f422f 320Requires write access to the C<NOTES_NAME> module.
bb4e9162
YST
321
322=back
323
324
325=head1 AUTHOR
326
613f422f 327C<NOTES_NAME> was automatically created using C<Module::Build>.
bb4e9162 328C<Module::Build> was written by Ken Williams, but he holds no
613f422f 329authorship claim or copyright claim to the contents of C<NOTES_NAME>.
bb4e9162 330
613f422f 331=end private
bb4e9162 332