Skip to content
This repository
tree: 2c8d7e24db
Fetching contributors…

Cannot retrieve contributors at this time

file 222 lines (168 sloc) 6.327 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
# Copyright (C) 2001-2011, Parrot Foundation.

package Parrot::Configure::Options;

use strict;
use warnings;
use base qw( Exporter );
our @EXPORT_OK = qw(
process_options
);
use Carp;
use File::Spec;
use lib qw( lib );
use Parrot::Configure::Options::Conf::CLI ();
use Parrot::Configure::Options::Conf::File ();
use Parrot::Configure::Options::Reconf ();

sub process_options {
    my $argsref = shift;

    croak "'mode' argument not provided to process_options()"
        unless defined $argsref->{mode};

    my ($options_components, $script);
    ($argsref, $options_components, $script) =
        _process_options_components($argsref);

    my ($data, $short_circuits_seen_ref) =
        _initial_pass($argsref, $options_components, $script);

    if (@{ $short_circuits_seen_ref }) {
        # run all the short circuits
        foreach my $sc (@{ $short_circuits_seen_ref }) {
            &{ $options_components->{short_circuits}{$sc} };
        }
        return;
    }
    else {
        if ($argsref->{mode} eq 'file' or $argsref->{mode} eq 'configure') {
            my $steps_list_ref;
            ($data, $steps_list_ref) =
                &{ $options_components->{conditionals} }($data);
            return ($data, $steps_list_ref);
        }
        else {
            $data = &{ $options_components->{conditionals} }($data);
            return $data;
        }
    }
}

sub _process_options_components {
    my $argsref = shift;
    my %options_components;
    if ( $argsref->{mode} =~ m/^reconfigure$/i ) {
        %options_components =
            %Parrot::Configure::Options::Reconf::options_components;
    }
    elsif ( $argsref->{mode} =~ m/^file$/i ) {
        %options_components =
            %Parrot::Configure::Options::Conf::File::options_components;
    }
    elsif ( $argsref->{mode} =~ m/^configure$/i ) {
        %options_components =
            %Parrot::Configure::Options::Conf::CLI::options_components;
    }
    else {
        croak "Invalid value for 'mode' argument to process_options()";
    }
    $argsref->{argv} = [] unless defined $argsref->{argv};

    my $script =
          $options_components{script}
        ? $options_components{script}
        : croak "Must provide value for 'script'";
    return ($argsref, \%options_components, $script);
}

sub _initial_pass {
    my ($argsref, $options_components, $script) = @_;
    my %valid_opts =
        map { $_, 1 } @{ $options_components->{valid_options} };
    my $data = {};
    my @short_circuits_seen = ();
    for my $el ( @{ $argsref->{argv} } ) {
        my ( $key, $value );
        if ($el =~ m/--([-\w]+)(?:=(.*))?/) {
            ( $key, $value ) = ($1, $2);
        }
        $key = 'help' unless defined $key;
        $value = 1 unless defined $value;

        unless ( $valid_opts{$key} ) {
            die qq/Invalid option "$key". See "perl $script --help" for valid options\n/;
        }
        if ( $key eq 'prefix' and
            ! File::Spec->file_name_is_absolute( $value) ) {
            die qq/Relative path given to --prefix, please pass an absolute path/;
        }
        if ( $options_components->{short_circuits}{$key} ) {
            push @short_circuits_seen, $key;
        }
        $data->{$key} = $value;
    }
    return ($data, \@short_circuits_seen);
}

1;

#################### DOCUMENTATION ####################

=head1 NAME

Parrot::Configure::Options - Process command-line options to F<Configure.pl>

=head1 SYNOPSIS

use Parrot::Configure::Options qw( process_options );

$args = process_options( {
mode => q{configure},
argv => [@ARGV],
} );

=head1 DESCRIPTION

Parrot::Configure::Options exports on demand the subroutine
C<process_options()>, which processes the command-line options provided to
F<Configure.pl> or to F<tools/dev/reconfigure.pl>.

If you provide F<Configure.pl> with either C<--help> or C<--version>,
C<process_options()> will print out the appropriate message and perform a
bare C<return>, I<i.e.>, the return value will be C<undef>. The calling
script -- whether F<Configure.pl> or a test file -- can then check for the
definedness of C<process_options()>'s return value and proceed appropriately.

An array of valid command-line option names stored internally is consulted;
the program will die if an invalid option is called.

=head1 SUBROUTINES

=head2 C<process_options()>

=over 4

=item * Purpose

Process command-line options provided to F<Configure.pl> and proceed
appropriately.

=item * Arguments

One argument: Reference to a hash holding the following key-value pairs:

mode : 'configure', 'reconfigure' or 'file'
argv : reference to @ARGV; defaults to []

=item * Return Value

=over 4

=item * C<--version> or C<--help> options

Bare return (C<undef>).

=item * All other options

Reference to a hash of option names and values.

=back

=item * Comment

The C<mode> element in the argument to C<process_options()> should be set
according to the following rules:

=over 4

=item * C<configure>

Command-Line Interface: Initial Parrot configuration with zero or more
command-line options (other than the C<--file> option). This is the most
typical case. See F<Configure.pl> or any test file simulating the
functionality of F<Configure.pl> in the F<t/configure/> or F<t/steps/>
directories.

=item * C<file>

Configuration-File Interface: Initial Parrot configuration where the options
are stored in a configuration file whose location is the value of the sole
command-line option C<--file>.

=item * C<reconfigure>

After F<Configure.pl> has completed, some Parrot developers need to rerun a
particular configuration step (typically, C<gen::makefiles>) to debug
revisions. F<tools/dev/reconfigure.pl> with the F<--step=step::class> option
does this and internally calls C<process_options()> in C<reconfigure> mode.

=back

=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::Conf.
Parrot::Configure::Options::Reconf. Parrot::Configure::Options::Conf::CLI.
Parrot::Configure::Options::Conf::File.

=cut

# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.