This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated CPANPLUS to cpan release 0.90
[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);
08fc25ad 7$VERSION = '0.35_09';
7a827510 8$VERSION = eval $VERSION;
bb4e9162
YST
9use Data::Dumper;
10use IO::File;
7a827510 11use Module::Build::Dumper;
bb4e9162 12
bb4e9162
YST
13sub new {
14 my ($class, %args) = @_;
15 my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
16 my $self = bless {
17 disk => {},
18 new => {},
19 file => $file,
20 %args,
21 }, $class;
22}
23
24sub restore {
25 my $self = shift;
26
27 my $fh = IO::File->new("< $self->{file}") or die "Can't read $self->{file}: $!";
28 $self->{disk} = eval do {local $/; <$fh>};
29 die $@ if $@;
30 $self->{new} = {};
31}
32
33sub access {
34 my $self = shift;
35 return $self->read() unless @_;
08fc25ad 36
bb4e9162
YST
37 my $key = shift;
38 return $self->read($key) unless @_;
08fc25ad 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 }
08fc25ad 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 ||= {};
08fc25ad 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 }
08fc25ad 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
08fc25ad
DG
98
99 @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
bb4e9162 100 $self->_dump($file, $self->{disk});
08fc25ad 101
bb4e9162
YST
102 $self->{new} = {};
103 }
104 return $self->read;
105}
106
107sub _dump {
108 my ($self, $file, $data) = @_;
08fc25ad 109
bb4e9162 110 my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
7a827510 111 print {$fh} Module::Build::Dumper->_data_dump($data);
bb4e9162
YST
112}
113
613f422f
DG
114my $orig_template = do { local $/; <DATA> };
115close DATA;
116
bb4e9162
YST
117sub write_config_data {
118 my ($self, %args) = @_;
119
613f422f
DG
120 my $template = $orig_template;
121 $template =~ s/NOTES_NAME/$args{config_module}/g;
122 $template =~ s/MODULE_NAME/$args{module}/g;
123 $template =~ s/=begin private\n//;
124 $template =~ s/=end private/=cut/;
125
126 # strip out private POD markers we use to keep pod from being
127 # recognized for *this* source file
128 $template =~ s{$_\n}{} for '=begin private', '=end private';
08fc25ad 129
bb4e9162 130 my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!";
613f422f
DG
131 print {$fh} $template;
132 print {$fh} "\n__DATA__\n";
133 print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);
134
135}
136
1371;
138
139
140=head1 NAME
141
142Module::Build::Notes - Create persistent distribution configuration modules
143
144=head1 DESCRIPTION
145
146This module is used internally by Module::Build to create persistent
147configuration files that can be installed with a distribution. See
148L<Module::Build::ConfigData> for an example.
149
150=head1 AUTHOR
bb4e9162 151
613f422f
DG
152Ken Williams <kwilliams@cpan.org>
153
154=head1 COPYRIGHT
155
156Copyright (c) 2001-2006 Ken Williams. All rights reserved.
157
158This library is free software; you can redistribute it and/or
159modify it under the same terms as Perl itself.
160
161=head1 SEE ALSO
162
163perl(1), L<Module::Build>(3)
164
165=cut
166
167__DATA__
168package NOTES_NAME;
bb4e9162
YST
169use strict;
170my $arrayref = eval do {local $/; <DATA>}
171 or die "Couldn't load ConfigData data: $@";
172close DATA;
173my ($config, $features, $auto_features) = @$arrayref;
174
175sub config { $config->{$_[1]} }
176
177sub set_config { $config->{$_[1]} = $_[2] }
178sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
179
613f422f 180sub auto_feature_names { grep !exists $features->{$_}, keys %$auto_features }
bb4e9162
YST
181
182sub feature_names {
613f422f 183 my @features = (keys %$features, auto_feature_names());
bb4e9162
YST
184 @features;
185}
186
613f422f 187sub config_names { keys %$config }
bb4e9162
YST
188
189sub write {
190 my $me = __FILE__;
191 require IO::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
199 my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
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
RGS
207 my $data = [$config, $features, $auto_features];
208 $fh->print( 'do{ my '
209 . Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
210 . '$x; }' );
bb4e9162
YST
211 truncate($fh, tell($fh));
212 $fh->close;
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};
08fc25ad 221
bb4e9162 222 my $info = $auto_features->{$key} or return 0;
08fc25ad 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;
08fc25ad 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';
08fc25ad 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');
08fc25ad 254
613f422f
DG
255 @names = NOTES_NAME->config_names;
256 @names = NOTES_NAME->feature_names;
08fc25ad 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