A simple preprocessing program

[Dirk Bremer]

Here is a simple preprocessing script for Perl scripts.

Dirk Bremer - Systems Programmer II - AMS Department - NISC
636-922-9158 ext. 652 fax 636-447-4471

<mailto:[EMAIL PROTECTED]>

# Preprocess.pl 03/13/2001.

# Define pragmas.
use diagnostics;
use English;
use strict;
use warnings;

# Define modules.
use FindBin qw($Bin);
use lib $Bin;
use Nisc;

# Define all subroutines.
sub InitializeProgram();
sub ProcessLoop();
sub StartProgram();
sub TerminateProgram();

# Import routines required by this program from the Nisc package.
*GetUserInput = \&Nisc::GetUserInput;

# Define global variables.
my %Defines      = ();
my $Help         = <<EOT;

This program will preprocess a Perl script. Preprocessing statements are as
follows and may occur in any position as long as they are the first
non-whitespace characters on the line:

#\$define name
#\$if defined name
#\$end define

Usage: Preprocess.pl input_file(r) args(o)
Where (r) = required, (o) = optional

Arguments:
    input_file - The file to be used as input to this program.
    args       - Arguments that will be passed to the processed script.

EOT
my $InputFile    = "";
my $LinesRead    = 0;
my $LinesWritten = 0;
my $OutputFile   = 'c:\temp\temp.pl';

# Call the controlling subroutine.
StartProgram();

#--------------------------------------------------------------------------#
# Structured program-control subroutine                                    #
#--------------------------------------------------------------------------#
sub StartProgram()
{
    InitializeProgram();
    ProcessLoop();
    TerminateProgram();

    exit(1);
}

#--------------------------------------------------------------------------#
# Program initialization subroutine                                        #
#--------------------------------------------------------------------------#
sub InitializeProgram()
{
    # Check if the -h option was entered.
    {
        use Getopt::Std;
        our $opt_h;
        getopts("h");

        # If the -h option was entered, print the help and exit the program.
        if (defined $opt_h)
        {
            print($Help);
            exit(1);
        }
    }

    # Check that the required number of arguments have been passed.
    if ($#ARGV < 0)
    {
        print($Help);
        $InputFile = GetUserInput("Enter the input filename",0);
        last SWITCH;
    }
    else
    {
        $InputFile = shift @ARGV;
    }

    # If a wildcarded filename was entered, resolve the wildcard and
    # reassign the variable to the first match found.
    if ($InputFile =~ /\*/o)
    {
        if ($InputFile !~ /\./o) {$InputFile = $InputFile . ".*";}
        my @Args = glob($InputFile);
        if ($#Args > -1) {$InputFile = $Args[0];}
    }

    # If the input filename does not have a file extension, add a default
    # file extension to the filename.
    if ($InputFile !~ /\.p[lm]$/io) {$InputFile = $InputFile . ".pl";}

    print("\nEntered Arguments:\n");
    print("Input File:    ",$InputFile,"\n");

    # Open all files.
    open(InputFileHnd,"<$InputFile")   or die "Unable to open $InputFile $!, stopped";
    open(OutputFileHnd,">$OutputFile") or die "Unable to open $OutputFile $!, stopped";

    return(1);
}

#--------------------------------------------------------------------------#
# Main processing subroutine                                               #
#--------------------------------------------------------------------------#
sub ProcessLoop()
{
    # Define local variables.
    my $Sw = 0;

    while (<InputFileHnd>)
    {
        chomp;
        $LinesRead++;

        # Check for define declarations.
        if (/\s*#\$define/o)
        {
            /\s*#\$define\s(\w+)/o;
            $Defines{$1} = 1;
            next;
        }

        # Check for the start of a define block.
        if (/\s*#\$if defined/o)
        {
            /\s*#\$if defined\s(\w+)/o;

            # If a define declaration exist for the current define name,
            # write the lines in this define block to the output file, else
            # set a switch skip this block.
            if (exists $Defines{$1}) {next;}
            $Sw = 1;
            next;
        }

        # Check for the end of a define block.
        if (/\s*#\$end define/o)
        {
            $Sw = 0;
            next;
        }

        # Skip the current line if the define block has not been declared.
        next if $Sw;

        print(OutputFileHnd "$_\n");
        $LinesWritten++;
    }

    return(1);
}

#--------------------------------------------------------------------------#
# Program termination subroutine                                           #
#--------------------------------------------------------------------------#
sub TerminateProgram()
{
    # Close all files.
    close(InputFileHnd);
    close(OutputFileHnd);

    # Display statistics.
    print("Lines Read:    $LinesRead\n");
    print("Lines Written: $LinesWritten\n");

    # Execute the processed file.
    system("perl -w $OutputFile @ARGV");

    return(1);
}



_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
http://listserv.ActiveState.com/mailman/listinfo/perl-win32-users