File Coverage

blib/lib/PBib/PBib/ConfigData.pm
Criterion Covered Total %
statement 18 40 45.0
branch 5 18 27.7
condition 3 7 42.8
subroutine 4 9 44.4
pod 8 8 100.0
total 38 82 46.3


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