File Coverage

File:lib/Parrot/Configure/Options/Conf/File.pm
Coverage:100.0%

linestmtbrancondsubcode
1# Copyright (C) 2007-2011, Parrot Foundation.
2
3package Parrot::Configure::Options::Conf::File;
4
5
103
103
103
103
use strict;
6
103
103
103
103
use warnings;
7
103
103
103
103
use base qw( Exporter );
8our @EXPORT_OK = qw(
9    @valid_options
10    $script
11    %options_components
12    $parrot_version
13);
14
15
103
103
103
103
use lib qw( lib );
16
103
103
103
103
use Parrot::BuildUtil;
17
103
use Parrot::Configure::Options::Conf qw(
18    $script
19    $parrot_version
20    print_help
21    print_version
22
103
103
103
);
23
103
use Parrot::Configure::Options::Conf::Shared qw(
24    @shared_valid_options
25
103
103
103
);
26
27our @valid_options = qw{
28    help
29    file
30    test
31    version
32};
33
34my %short_circuits = (
35    help => \&print_help,
36    version => \&print_version,
37);
38
39our %options_components = (
40    'valid_options' => \@valid_options,
41    'script' => $script,
42    'short_circuits' => \%short_circuits,
43    'conditionals' => \&conditional_assignments,
44);
45
46sub conditional_assignments {
47
7
7
    my $data = shift;
48
7
    $data->{debugging} = 1;
49
7
    $data->{maintainer} = undef;
50
7
525
    my %valid_step_options = map {$_ => 1} @shared_valid_options;
51
7
    my $file_str = Parrot::BuildUtil::slurp_file($data->{file});
52
7
    my $steps_list_ref;
53
7
100
    if ($file_str =~ m/=variables\s*?\n
54        (.*?)
55        \s*\n
56        =general\s*?\n
57        (.*?)
58        \s*\n
59        =steps\s*?\n
60        (.*?)
61        \s*\n
62        =cut
63        /sx ) {
64
6
        my ($variables, $general, $steps) = ($1,$2,$3);
65
6
        my $substitutions = _get_substitutions($variables);
66
6
        $data = _set_general($data, $substitutions, $general,
67            \%valid_step_options);
68
4
        ($data, $steps_list_ref) =
69            _set_steps($data, $steps, \%valid_step_options);
70    }
71    else {
72
1
        die "Configuration file $data->{file} did not parse correctly: $!";
73    }
74
3
    return ($data, $steps_list_ref);
75}
76
77sub _get_substitutions {
78
6
6
    my $variables = shift;
79
6
    my @variables = split /\n/, $variables;
80
6
    my %substitutions;
81
6
    foreach my $v (@variables) {
82
9
100
        next unless $v =~ m/^(\w+)=([^=]+)$/;
83
6
        my ($k, $v) = ($1, $2);
84
6
        $substitutions{$k} = $v;
85    }
86
6
    return \%substitutions;
87}
88
89sub _set_general {
90
6
6
    my ($data, $substitutions, $general, $optsref) = @_;
91
6
    my @general = split /\n/, $general;
92
6
    foreach my $g (@general) {
93
11
100
100
        next unless ( $g =~ m/^
94            ([-\w]+)
95            (?:=(
96                \S+ # Usual case: regular identifier; no spaces allowed in identifier
97                |
98                \$\S+ # Variable substitution; no spaces allowed in identifier
99                )
100            )?
101           $/x )
102            or
103        ( $g =~ m/^([-\w]+)="([^"]+)"$/ ); # Double-quoted string; spaces allowed
104
7
        my ($k, $v, $prov, $var);
105
7
100
        if ($2) {
106
5
            ($k, $prov) = ($1, $2);
107
5
100
            if ($prov =~ m/^\$(.+)/) {
108
3
                $var = $1;
109
3
100
                if ($substitutions->{$var}) {
110
2
                    $v = $substitutions->{$var};
111                }
112                else {
113
1
                    die "Bad variable substitution in $data->{file}: $!";
114                }
115            }
116            else {
117
2
                $v = $prov;
118            }
119        }
120        else {
121
2
            $k = $1;
122
2
            $v = 1;
123        }
124
6
100
        if (! $optsref->{$k}) {
125
1
            die "Invalid general option $k in $data->{file}: $!";
126        }
127        else {
128
5
            $data->{$k} = $v;
129        }
130    }
131
4
    return $data;
132}
133
134sub _set_steps {
135
4
4
    my ($data, $steps, $optsref) = @_;
136
4
    my @steplines = split /\n/, $steps;
137
4
    my @steps_list = ();
138
4
    LINE: foreach my $line (@steplines) {
139
194
100
        next unless ($line =~ /^(\w+::\w+)(?:\s+([-=\w]+\s+)*([-=\w]+))?$/);
140
185
        my $step = $1;
141
185
        push @steps_list, $step;
142
185
100
        next LINE unless $3;
143
7
100
        my $opts_string = $2 ? qq{$2$3} : $3;
144
7
        my @opts = split /\s+/, $opts_string;
145
7
        foreach my $el (@opts) {
146
9
            my ( $key, $value ) = $el =~ m/([-\w]+)(?:=(.*))?/;
147
9
100
            unless ( $optsref->{$key} ) {
148
1
                die qq/Invalid option "$key". See "perl Configure.pl --help" for options valid within a configuration file\n/;
149            }
150            # This will have to be fixed to allow for possibility that >1 step
151            # might be declared a verbose-step or a fatal-step.
152
8
100
            $value = $step if $key eq 'verbose-step';
153
8
100
            $value = $step if $key eq 'fatal-step';
154
8
100
            $value = 1 unless defined $value;
155
8
            $data->{$key} = $value;
156        }
157    }
158
3
    return ($data, \@steps_list);
159}
160
1611;
162
163#################### DOCUMENTATION ####################
164
165 - 295
=head1 NAME

Parrot::Configure::Options::Conf::File - Options processing functionality for
Parrot's configuration-file interface

=head1 SYNOPSIS

    use Parrot::Configure::Options::Conf::File qw(
        @valid_options
        $script
        %options_components
        $parrot_version
    );

=head1 DESCRIPTION

This package exports four variables on demand.

    %options_components
    @valid_options
    $script
    $parrot_version

Typically, only one of these -- C<%options_components> -- is directly imported
by Parrot::Configure::Options for use in the case where options are supplied
to F<Configure.pl> on the command-line.  But all five are, in principle,
importable by other packages.

=head2 C<%options_components>

    %options_components = (
        'valid_options'  => \@valid_options,
        'script'         => $script,
        'short_circuits' => \%short_circuits,
        'conditionals'   => \&conditional_assignments,
    );

Hash with four elements keyed as follows:

=over 4

=item * C<valid_options>

Reference to an array holding a list of options are valid when configuring
Parrot via the traditional Command-Line interface.  The options are documented
when you call C<perl Configure.pl --help> and include C<--ask> to request
interactive configuration.

=item * C<script>

Defaults to string 'Configure.pl', but may be overridden for testing purposes.

=item * C<short_circuits>

Reference to a hash with two elements:

=over 4

=item * C<help>

Reference to subroutine C<print_help>, which prints F<Configure.pl>'s help
message.  Since this subroutine is shared with another package, it is
actually imported from Parrot::Configure::Options::Conf.

=item * C<version>

Reference to subroutine C<print_version>, which prints F<Configure.pl>'s
version number.  Since this subroutine is shared with another package, it is
actually imported from Parrot::Configure::Options::Conf.

=back

=item * C<conditionals>

Reference to a subroutine private to this package which:

=over 4

=item *

Sets default values for the C<debugging> and C<maintainer> options under most
situations.

=item *

Fetches the list of configuration steps from Parrot::Configure::Step::List.
When you configure with the Command-Line Interface, you use the canonical list
of configuration steps provided by that package.

=back

The subroutine takes a single argument:  a reference to a hash holding
elements concerned with configuration, such as the valid options.

The subroutine returns a two-argument list:

=over 4

=item *

An augmented version of the hash reference passed in as an argument.

=item *

Reference to array holding list of configuration steps.

=back

That's probably difficult to understand at first.  So here is an example of
how C<$options_components-E<gt>{conditionals}> is actually used inside
C<Parrot::Configure::Options::process_options()>.

    my $data;
    # $data is hash ref which gets assigned some key-value pairs
    my $steps_list_ref;
    ($data, $steps_list_ref) =
        &{ $options_components->{conditionals} }($data);

=back

=head1 NOTES

The functionality in this package originally appeared in F<Configure.pl>.  It
was transferred here and refactored by James E Keenan.

=head1 SEE ALSO

F<Configure.pl>. Parrot::Configure::Options.  Parrot::Configure::Options::Conf.
Parrot::Configure::Options::Reconf.  Parrot::Configure::Options::Conf::CLI.

=cut
296
297# Local Variables:
298# mode: cperl
299# cperl-indent-level: 4
300# fill-column: 100
301# End:
302# vim: expandtab shiftwidth=4: