openmp/runtime/tools/expand-vars.pl

#!/usr/bin/perl

#
#//===----------------------------------------------------------------------===//
#//
#//                     The LLVM Compiler Infrastructure
#//
#// This file is dual licensed under the MIT and the University of Illinois Open
#// Source Licenses. See LICENSE.txt for details.
#//
#//===----------------------------------------------------------------------===//
#

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/lib";

use tools;

our $VERSION = "0.005";

my $name_rexp    = qr{[A-Za-z_]+[A-Za-z0-9_]*};
my $keyword_rexp = qr{if|else|end|omp};

sub error($$$) {
    my ( $input, $msg, $bulk ) = @_;
    my $pos = pos( $$bulk );
    $$bulk =~ m{^(.*?)\G(.*?)$}m or die "Internal error";
    my ( $pre, $post ) = ( $1, $2 );
    my $n = scalar( @{ [ substr( $$bulk, 0, $pos ) =~ m{\n}g ] } ) + 1;
    runtime_error( "\"$input\" line $n: $msg:", ">>> " . $pre . "--[HERE]-->" . $post );
}; # sub error

sub evaluate($$$\$) {
    my ( $expr, $strict, $input, $bulk ) = @_;
    my $value;
    { # Signal handler will be restored on exit from this block.
        # In case of "use strict; use warnings" eval issues warnings to stderr. This direct
        # output may confuse user, so we need to catch it and prepend with our info.
        local $SIG{ __WARN__ } = sub { die @_; };
        $value =
            eval(
                "package __EXPAND_VARS__;\n" .
                ( $strict ? "use strict; use warnings;\n" : "no strict; no warnings;\n" ) .
                $expr
            );
    };
    if ( $@ ) {
        # Drop location information -- increasing eval number and constant "line 3"
        # is useless for the user.
        $@ =~ s{ at \(eval \d+\) line \d+}{}g;
        $@ =~ s{\s*\z}{};
        error( $input, "Cannot evaluate expression \"\${{$expr}}\": $@", $bulk );
    }; # if
    if ( $strict and not defined( $value ) ) {
        error( $input, "Substitution value is undefined", $bulk );
    }; # if
    return $value;
}; # sub evaluate

#
# Parse command line.
#

my ( @defines, $input, $output, $strict );
get_options(
    "D|define=s" => \@defines,
    "strict!"    => \$strict,
);
if ( @ARGV < 2 ) {
    cmdline_error( "Not enough argument" );
}; # if
if ( @ARGV > 2 ) {
    cmdline_error( "Too many argument(s)" );
}; # if
( $input, $output ) = @ARGV;

foreach my $define ( @defines ) {
    my ( $equal, $name, $value );
    $equal = index( $define, "=" );
    if ( $equal < 0 ) {
        $name = $define;
        $value = "";
    } else {
        $name = substr( $define, 0, $equal );
        $value = substr( $define, $equal + 1 );
    }; # if
    if ( $name eq "" ) {
        cmdline_error( "Illegal definition: \"$define\": variable name should not be empty." );
    }; # if
    if ( $name !~ m{\A$name_rexp\z} ) {
        cmdline_error(
            "Illegal definition: \"$define\": " .
                "variable name should consist of alphanumeric characters."
        );
    }; # if
    eval( "\$__EXPAND_VARS__::$name = \$value;" );
    if ( $@ ) {
        die( "Internal error: $@" );
    }; # if
}; # foreach $define

#
# Do the work.
#

my $bulk;

# Read input file.
$bulk = read_file( $input );

# Do the replacements.
$bulk =~
    s{(?:\$($keyword_rexp)|\$($name_rexp)|\${{(.*?)}})}
    {
        my $value;
        if ( defined( $1 ) ) {
            # Keyword. Leave it as is.
            $value = "\$$1";
        } elsif ( defined( $2 ) ) {
            # Variable to expand.
            my $name = $2;
            $value = eval( "\$__EXPAND_VARS__::$name" );
            if ( $@ ) {
                die( "Internal error" );
            }; # if
            if ( $strict and not defined( $value ) ) {
                error( $input, "Variable \"\$$name\" not defined", \$bulk );
            }; # if
        } else {
            # Perl code to evaluate.
            my $expr = $3;
            $value = evaluate( $expr, $strict, $input, $bulk );
        }; # if
        $value;
    }ges;

# Process conditionals.
# Dirty patch! Nested conditionals not supported!
# TODO: Implement nested constructs.
$bulk =~
    s{^\$if +([^\n]*) *\n(.*\n)\$else *\n(.*\n)\$end *\n}
    {
        my ( $expr, $then_part, $else_part ) = ( $1, $2, $3 );
        my $value = evaluate( $expr, $strict, $input, $bulk );
        if ( $value ) {
            $value = $then_part;
        } else {
            $value = $else_part;
        }; # if
    }gesm;

# Write output.
write_file( $output, \$bulk );

exit( 0 );

__END__

=pod

=head1 NAME

B<expand-vars.pl> -- Simple text preprocessor.

=head1 SYNOPSIS

B<expand-vars.pl> I<OPTION>... I<input> I<output>

=head1 OPTIONS

=over

=item B<-D> I<name>[B<=>I<value>]

=item B<--define=>I<name>[B<=>I<value>]

Define variable.

=item B<--strict>

In strict mode, the script issues error on using undefined variables and executes Perl code
with C<use strict; use warnings;> pragmas.

=back

=head2 Standard Options

=over

=item B<--doc>

=item B<--manual>

Print full help message and exit.

=item B<--help>

Print short help message and exit.

=item B<--usage>

Print very short usage message and exit.

=item B<--verbose>

Do print informational messages.

=item B<--version>

Print version and exit.

=item B<--quiet>

Work quiet, do not print informational messages.

=back

=head1 ARGUMENTS

=over

=item I<input>

Input file name.

=item I<output>

Output file name.

=back

=head1 DESCRIPTION

This script reads input file, makes substitutes and writes output file.

There are two form of substitutes:

=over

=item Variables

Variables are referenced in input file in form:

    $name

Name of variable should consist of alphanumeric characters (Latin letters, digits, and underscores).
Variables are defined in command line with C<-D> or C<--define> options.

=item Perl Code

Perl code is specified in input file in form:

    ${{ ...code... }}

The code is evaluated, and is replaced with its result. Note: in strict mode, you should declare
variable before use. See examples.

=back

=head1 EXAMPLES

Replace occurrences of C<$year>, C<$month>, and C<$day> in C<input.txt> file with C<2007>, C<09>, C<01>
respectively and write result to C<output.txt> file:

    $ cat input.var
    Today is $year-$month-$day.
    $ expand-vars.pl -D year=2007 -D month=09 -D day=01 input.var output.txt && cat output.txt
    Today is 2007-09-01.

Using Perl code:

    $ cat input.var
    ${{ localtime(); }}
    $ expand-vars.pl -D year=2007 -D month=09 -D day=01 input.var output.txt && cat output.txt
    Now Tue May  5 20:54:13 2009

Using strict mode for catching bugs:

    $ cat input.var
    ${{ "year : " . substr( $date, 0, 4 ); }}
    $ expand-vars.pl input.var output.txt && cat output.txt
    year :

Oops, why it does not print year? Let us use strict mode:

    $ expand-vars.pl --strict input.var output.txt && cat output.txt
    expand-vars.pl: (x) "test.var": Cannot evaluate expression "${{ "year : " . substr( $date, 0, 4 ); }}": Global symbol "$date" requires explicit package name

Ok, variable is not defined. Let us define it:

    $ expand-vars.pl --strict -D date=20090501 input.var output.txt && cat output.txt
    expand-vars.pl: (x) "test.var": Cannot evaluate expression "${{ "year : " . substr( $date, 0, 4 ); }}": Variable "$date" is not imported

What is wrong? Variable should be declared:

    $ cat input.var
    ${{ our $date; "year : " . substr( $date, 0, 4 ); }}
    $ expand-vars.pl --strict -D date=20090501 input.var output.txt && cat output.txt
    year : 2009

=cut

# end of file #