File Coverage

blib/lib/FFI/Platypus/Lang/Fortran/ConfigData.pm
Criterion Covered Total %
statement 4 39 10.2
branch 0 18 0.0
condition 0 7 0.0
subroutine 2 9 22.2
pod 8 8 100.0
total 14 81 17.2


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