1 package Module::Build::Notes;
3 # A class for persistent hashes
8 $VERSION = eval $VERSION;
11 use Module::Build::Dumper;
14 my ($class, %args) = @_;
15 my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
27 my $fh = IO::File->new("< $self->{file}") or die "Can't read $self->{file}: $!";
28 $self->{disk} = eval do {local $/; <$fh>};
35 return $self->read() unless @_;
38 return $self->read($key) unless @_;
41 $self->write({ $key => $value });
42 return $self->read($key);
47 return keys %{$self->read()} > 0;
51 my ($self, $key) = @_;
52 return exists($self->{new}{$key}) || exists($self->{disk}{$key});
59 # Return 1 key as a scalar
61 return $self->{new}{$key} if exists $self->{new}{$key};
62 return $self->{disk}{$key};
66 my $out = (keys %{$self->{new}}
67 ? {%{$self->{disk}}, %{$self->{new}}}
69 return wantarray ? %$out : $out;
73 my ($self, $x, $y) = @_;
74 return 1 if !defined($x) and !defined($y);
75 return 0 if !defined($x) or !defined($y);
80 my ($self, $href) = @_;
83 @{$self->{new}}{ keys %$href } = values %$href; # Merge
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});
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
97 return if -e $file and !keys %{ $self->{new} }; # Nothing to do
99 @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
100 $self->_dump($file, $self->{disk});
108 my ($self, $file, $data) = @_;
110 my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
111 print {$fh} Module::Build::Dumper->_data_dump($data);
114 sub write_config_data {
115 my ($self, %args) = @_;
117 my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!";
119 printf $fh <<'EOF', $args{config_module};
122 my $arrayref = eval do {local $/; <DATA>}
123 or die "Couldn't load ConfigData data: $@";
125 my ($config, $features, $auto_features) = @$arrayref;
127 sub config { $config->{$_[1]} }
129 sub set_config { $config->{$_[1]} = $_[2] }
130 sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
132 sub auto_feature_names { grep !exists $features->{$_}, keys %%$auto_features }
135 my @features = (keys %%$features, auto_feature_names());
139 sub config_names { keys %%$config }
145 # Can't use Module::Build::Dumper here because M::B is only a
146 # build-time prereq of this module
147 require Data::Dumper;
149 my $mode_orig = (stat $me)[2] & 07777;
150 chmod($mode_orig | 0222, $me); # Make it writeable
151 my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
154 last if /^__DATA__$/;
156 die "Couldn't find __DATA__ token in $me" if eof($fh);
158 seek($fh, tell($fh), 0);
159 my $data = [$config, $features, $auto_features];
160 $fh->print( 'do{ my '
161 . Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
163 truncate($fh, tell($fh));
166 chmod($mode_orig, $me)
167 or warn "Couldn't restore permissions on $me: $!";
171 my ($package, $key) = @_;
172 return $features->{$key} if exists $features->{$key};
174 my $info = $auto_features->{$key} or return 0;
176 # Under perl 5.005, each(%%$foo) isn't working correctly when $foo
177 # was reanimated with Data::Dumper and eval(). Not sure why, but
178 # copying to a new hash seems to solve it.
181 require Module::Build; # XXX should get rid of this
182 while (my ($type, $prereqs) = each %%info) {
183 next if $type eq 'description' || $type eq 'recommends';
185 my %%p = %%$prereqs; # Ditto here.
186 while (my ($modname, $spec) = each %%p) {
187 my $status = Module::Build->check_installed_status($modname, $spec);
188 if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
196 my ($module_name, $notes_name) = ($args{module}, $args{config_module});
197 printf $fh <<"EOF", $notes_name, $module_name;
201 $notes_name - Configuration for $module_name
207 \$value = $notes_name->config('foo');
208 \$value = $notes_name->feature('bar');
210 \@names = $notes_name->config_names;
211 \@names = $notes_name->feature_names;
213 $notes_name->set_config(foo => \$new_value);
214 $notes_name->set_feature(bar => \$new_value);
215 $notes_name->write; # Save changes
220 This module holds the configuration data for the C<$module_name>
221 module. It also provides a programmatic interface for getting or
222 setting that configuration data. Note that in order to actually make
223 changes, you'll have to have write access to the C<$notes_name>
224 module, and you should attempt to understand the repercussions of your
234 Given a string argument, returns the value of the configuration item
235 by that name, or C<undef> if no such item exists.
237 =item feature(\$name)
239 Given a string argument, returns the value of the feature by that
240 name, or C<undef> if no such feature exists.
242 =item set_config(\$name, \$value)
244 Sets the configuration item with the given name to the given value.
245 The value may be any Perl scalar that will serialize correctly using
246 C<Data::Dumper>. This includes references, objects (usually), and
247 complex data structures. It probably does not include transient
248 things like filehandles or sockets.
250 =item set_feature(\$name, \$value)
252 Sets the feature with the given name to the given boolean value. The
253 value will be converted to 0 or 1 automatically.
257 Returns a list of all the names of config items currently defined in
258 C<$notes_name>, or in scalar context the number of items.
260 =item feature_names()
262 Returns a list of all the names of features currently defined in
263 C<$notes_name>, or in scalar context the number of features.
265 =item auto_feature_names()
267 Returns a list of all the names of features whose availability is
268 dynamically determined, or in scalar context the number of such
269 features. Does not include such features that have later been set to
274 Commits any changes from C<set_config()> and C<set_feature()> to disk.
275 Requires write access to the C<$notes_name> module.
282 C<$notes_name> was automatically created using C<Module::Build>.
283 C<Module::Build> was written by Ken Williams, but he holds no
284 authorship claim or copyright claim to the contents of C<$notes_name>.
292 print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);