1 package Module::Build::Notes;
3 # A class for persistent hashes
9 use Carp; BEGIN{ $SIG{__DIE__} = \&carp::confess }
12 my ($class, %args) = @_;
13 my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
25 my $fh = IO::File->new("< $self->{file}") or die "Can't read $self->{file}: $!";
26 $self->{disk} = eval do {local $/; <$fh>};
33 return $self->read() unless @_;
36 return $self->read($key) unless @_;
39 $self->write({ $key => $value });
40 return $self->read($key);
45 return keys %{$self->read()} > 0;
49 my ($self, $key) = @_;
50 return exists($self->{new}{$key}) || exists($self->{disk}{$key});
57 # Return 1 key as a scalar
59 return $self->{new}{$key} if exists $self->{new}{$key};
60 return $self->{disk}{$key};
64 my $out = (keys %{$self->{new}}
65 ? {%{$self->{disk}}, %{$self->{new}}}
67 return wantarray ? %$out : $out;
71 my ($self, $x, $y) = @_;
72 return 1 if !defined($x) and !defined($y);
73 return 0 if !defined($x) or !defined($y);
78 my ($self, $href) = @_;
81 @{$self->{new}}{ keys %$href } = values %$href; # Merge
83 # Do some optimization to avoid unnecessary writes
84 foreach my $key (keys %{ $self->{new} }) {
85 next if ref $self->{new}{$key};
86 next if ref $self->{disk}{$key} or !exists $self->{disk}{$key};
87 delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key});
90 if (my $file = $self->{file}) {
91 my ($vol, $dir, $base) = File::Spec->splitpath($file);
92 $dir = File::Spec->catpath($vol, $dir, '');
93 return unless -e $dir && -d $dir; # The user needs to arrange for this
95 return if -e $file and !keys %{ $self->{new} }; # Nothing to do
97 @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
98 $self->_dump($file, $self->{disk});
106 my ($self, $file, $data) = @_;
108 my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
109 local $Data::Dumper::Terse = 1;
110 print $fh Data::Dumper::Dumper($data);
113 sub write_config_data {
114 my ($self, %args) = @_;
116 my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!";
118 printf $fh <<'EOF', $args{config_module};
121 my $arrayref = eval do {local $/; <DATA>}
122 or die "Couldn't load ConfigData data: $@";
124 my ($config, $features, $auto_features) = @$arrayref;
126 sub config { $config->{$_[1]} }
128 sub set_config { $config->{$_[1]} = $_[2] }
129 sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
131 sub auto_feature_names { grep !exists $features->{$_}, keys %%$auto_features }
134 my @features = (keys %%$features, auto_feature_names());
138 sub config_names { keys %%$config }
143 require Data::Dumper;
145 my $mode_orig = (stat $me)[2] & 07777;
146 chmod($mode_orig | 0222, $me); # Make it writeable
147 my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
150 last if /^__DATA__$/;
152 die "Couldn't find __DATA__ token in $me" if eof($fh);
154 local $Data::Dumper::Terse = 1;
155 seek($fh, tell($fh), 0);
156 $fh->print( Data::Dumper::Dumper([$config, $features, $auto_features]) );
157 truncate($fh, tell($fh));
160 chmod($mode_orig, $me)
161 or warn "Couldn't restore permissions on $me: $!";
165 my ($package, $key) = @_;
166 return $features->{$key} if exists $features->{$key};
168 my $info = $auto_features->{$key} or return 0;
170 # Under perl 5.005, each(%%$foo) isn't working correctly when $foo
171 # was reanimated with Data::Dumper and eval(). Not sure why, but
172 # copying to a new hash seems to solve it.
175 require Module::Build; # XXX should get rid of this
176 while (my ($type, $prereqs) = each %%info) {
177 next if $type eq 'description' || $type eq 'recommends';
179 my %%p = %%$prereqs; # Ditto here.
180 while (my ($modname, $spec) = each %%p) {
181 my $status = Module::Build->check_installed_status($modname, $spec);
182 if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
190 my ($module_name, $notes_name) = ($args{module}, $args{config_module});
191 printf $fh <<"EOF", $notes_name, $module_name;
195 $notes_name - Configuration for $module_name
201 \$value = $notes_name->config('foo');
202 \$value = $notes_name->feature('bar');
204 \@names = $notes_name->config_names;
205 \@names = $notes_name->feature_names;
207 $notes_name->set_config(foo => \$new_value);
208 $notes_name->set_feature(bar => \$new_value);
209 $notes_name->write; # Save changes
214 This module holds the configuration data for the C<$module_name>
215 module. It also provides a programmatic interface for getting or
216 setting that configuration data. Note that in order to actually make
217 changes, you'll have to have write access to the C<$notes_name>
218 module, and you should attempt to understand the repercussions of your
228 Given a string argument, returns the value of the configuration item
229 by that name, or C<undef> if no such item exists.
231 =item feature(\$name)
233 Given a string argument, returns the value of the feature by that
234 name, or C<undef> if no such feature exists.
236 =item set_config(\$name, \$value)
238 Sets the configuration item with the given name to the given value.
239 The value may be any Perl scalar that will serialize correctly using
240 C<Data::Dumper>. This includes references, objects (usually), and
241 complex data structures. It probably does not include transient
242 things like filehandles or sockets.
244 =item set_feature(\$name, \$value)
246 Sets the feature with the given name to the given boolean value. The
247 value will be converted to 0 or 1 automatically.
251 Returns a list of all the names of config items currently defined in
252 C<$notes_name>, or in scalar context the number of items.
254 =item feature_names()
256 Returns a list of all the names of features currently defined in
257 C<$notes_name>, or in scalar context the number of features.
259 =item auto_feature_names()
261 Returns a list of all the names of features whose availability is
262 dynamically determined, or in scalar context the number of such
263 features. Does not include such features that have later been set to
268 Commits any changes from C<set_config()> and C<set_feature()> to disk.
269 Requires write access to the C<$notes_name> module.
276 C<$notes_name> was automatically created using C<Module::Build>.
277 C<Module::Build> was written by Ken Williams, but he holds no
278 authorship claim or copyright claim to the contents of C<$notes_name>.
286 local $Data::Dumper::Terse = 1;
287 print $fh Data::Dumper::Dumper([$args{config_data}, $args{feature}, $args{auto_features}]);