#!/usr/local/bin/perl -w
########################################################################
#
# filepp is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
########################################################################
#
#  Project      :  File Preprocessor
#  Filename     :  $RCSfile: filepp.in,v $
#  Author       :  $Author: darren $
#  Maintainer   :  Darren Miller: darren@cabaret.demon.co.uk
#  File version :  $Revision: 1.42 $
#  Last changed :  $Date: 2001/02/18 11:43:00 $
#  Description  :  Main program
#  Licence      :  GNU copyleft
#
########################################################################

package Filepp;

use strict "vars";
use strict "subs";

# version number of program
my $VERSION = '1.2.0';

# index of keywords supported and functions to deal with them
my %Keywords = (
		'comment', \&Comment,
		'define',  \&Define,
		'elif',    \&Elif,
		'else',    \&Else,
		'endif',   \&Endif,
		'error',   \&Error,
		'if', 	   \&If,
		'ifdef',   \&Ifdef,
		'ifndef',  \&Ifndef,
		'include', \&Include,
		'pragma',  \&Pragma,
		'undef',   \&Undef,
		'warning', \&Warning
		);
# sort keywords index into reverse order, this ensures #if[n]def comes
# before #if when comparing input with keywords
my @Keywords = sort {$b cmp $a} (keys(%Keywords));

# character(s) which prefix keywords - defaults to C-style '#'
my $keywordchar = "\#";

# safe mode is for the paranoid, when enabled turns off #pragma filepp,
# enabled by default
my $safe_mode = 0;

# character(s) which signifies continution of a line - defaults to C-style '\'
my $contchar = "\\\\";

# character(s) which replace continution char(s) - defaults to C-style nothing
my $contrepchar = "";

# number of line currently being parsed (int)
my $line = 0;

# file currently being parsed
my $file = "";

# base file currently being parsed
my $base_file = "";

# list of input files
my @Inputfiles;
my $num_inputfiles = 0;

# input from STDIN
my $input_stdin = 0;

# name of outputfile - defaults to STDOUT
my $outputfile = "";

# output to STDOUT
my $output_stdout = 0;

# set if file being written to has same name as input file
my $same_file = 0;

# flag to control when to write output
my $write = 1;

# counter for number of #if[n][def] loops currently in
my $ifcount = 0;

# counter which shows last #if[n][def] tested as true
my $ifwrite = 0;

# current level of include files
my $include_level = -1;

# debugging info, 1=on, 0=off
my $debug = 0;

# conversions of month number into letters (0-11)
my %MonthChars = ('00', 'Jan',
		  '01', 'Feb',
		  '02', 'Mar',
		  '03', 'Apr',
		  '04', 'May',
		  '05', 'Jun',
		  '06', 'Jul',
		  '07', 'Aug',
		  '08', 'Sep',
		  '09', 'Oct',
		  '10', 'Nov',
		  '11', 'Dec');

#prepare standard defines
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isbst) = 
    localtime(time());
$year += 1900;
$sec  = IntPad($sec,  2);
$min  = IntPad($min,  2);
$hour = IntPad($hour, 2);
$mday = IntPad($mday, 2);
$mon  = IntPad($mon,  2);
my $time = "$hour:$min:$sec";
my $date = "$MonthChars{$mon} $mday $year";
$mon++;
my $isodate = "$year-$mon-$mday";

# hash of macros defined - standard ones already included
my %Defines = (
	       '__BASE_FILE__',     "$base_file",
	       '__DATE__',          "$date",
	       '__FILEPP_INPUT__',  "Generated automatically from __BASE_FILE__ by filepp",
	       '__FILE__',          "$file",
	       '__INCLUDE_LEVEL__', "$include_level",
	       '__ISO_DATE__',      "$isodate",
	       '__LINE__',          "$line",
	       '__NULL__',          "",
	       '__TIME__',          "$time",
	       '__VERSION__',       "$VERSION"
	       );
my @Defines =  sort {$b cmp $a} (keys(%Defines));

# hash table for arguments to macros which need them
my %DefinesArgs = ();
my @DefinesArgs = keys(%DefinesArgs); ;

# list of include paths
my @IncludePaths;
my $num_includepaths = 0;

# help string
my $usage = "filepp: generic file preprocessor, version $VERSION
usage: filepp [options] inputfile(s)
options:
 -c\t\tread input from STDIN instead of file
 -Dmacro[=defn]\tdefine macros (same as #define)
 -d\t\tprint debugging information
 -h\t\tprint this help message
 -Idir\t\tdirectory to search for include files
 -k\t\tturn off parsing of all keywords, just macro expansion is done
 -kc char\tset keyword prefix char to \"char\" (defaults to $keywordchar)
 -lc char\tset line continution character to \"char\" (defaults to \\)
 -lr char\tset line continution replacement character to \"char\"
 -lrn\t\tset line continution replacement character to newline
 -m module\tload module
 -o output\tname of output file (defaults to stdout)
 -s\t\trun in safe mode (turns off pragma keyword)
 -v\t\tprint version and exit
 all other arguments are assumed to be input files
";


##############################################################################
# Debugging info
##############################################################################
sub Debug
{
    # print nothing if not debugging
    if($debug == 0) {
	return;
    }    
    my $msg = shift;
    # if currently parsing a file show filename and line number
    if($file ne "" && $line > 0) {
	$msg = "$file:$line: $msg";
    }
    # else show program name
    else {
	$msg = "filepp: $msg";
    }
    print(STDERR "$msg\n");
}


##############################################################################
# Standard error handler.
# #error msg  - print error message "msg" and exit
##############################################################################
sub Error
{
    my $msg = shift;
    # close and delete output file if created
    close(OUTPUT);
    if($output_stdout == 0) {
	my $i;
	my $found = 0;
	# do paranoid check to make sure we are not deleting an input file
	for($i=0; $i<$num_inputfiles; $i++) {
	    if($outputfile eq $Inputfiles[$i]) {
		$found = 1;
	    }
	}
	# delete output file
	if($found == 0) {
	    unlink($outputfile);
	}
    }
    # print error message
    $debug = 1;
    Debug($msg);
    exit(1);
}


##############################################################################
# SafeMode - turns safe mode on
##############################################################################
sub SafeMode
{
    $safe_mode = 1;
    Debug("Filepp safe mode enabled");
}


##############################################################################
# IntPad($int, $pad) Pad an integer $int with zeros to width $pad
##############################################################################
sub IntPad
{
    my $int = shift;
    my $pad = shift;
    while(length($int) < $pad) {
	$int = "0$int";
    }
    return $int;
}


##############################################################################
# CleanStart($sline) - strip leading whitespace from start of $sline.
##############################################################################
sub CleanStart
{
    my $sline = shift;
    # '^' = start of line, '\s+' means all whitespace, replace with nothing
    $sline =~ s/^\s+//;
    return $sline;
}


##############################################################################
# CleanStartEnd($sline) - strip leading whitespace from start and end of
# $sline
##############################################################################
sub CleanStartEnd
{
    my $sline = shift;
    for($sline) {
	# '^' = start of line, '\s+' means all whitespace, replace with nothing
	s/^\s+//;
	# '$' = end of line, '\s+' means all whitespace, replace with nothing
	s/\s+$//m;
    }
    return $sline;
}


##############################################################################
# Strip($sline, $char, $level) - strip $char's from start and end of $sline
# removes up to $level $char's from start and end of line, it is not an
# error if $level chars do not exist at the start or end of line
##############################################################################
sub Strip
{
    my $sline = shift;
    my $char = shift;
    my $level = shift;
    # strip leading chars from line
    $sline =~ s/^([$char]{0,$level})//g;
    # strip trailing chars from line
    $sline =~ s/([$char]{0,$level})$//g;
    return $sline;
}


##############################################################################
# SetKeywordchar $string - sets the first char(s) of each keyword to
# something other than "#"
##############################################################################
sub SetKeywordchar
{
    $keywordchar = shift;
    Debug("Setting keyword prefix character to <$keywordchar>");
}


##############################################################################
# SetContchar $string - sets the line continution char to something other
# than "\"
##############################################################################
sub SetContchar
{
    $contchar = shift;
    Debug("Setting line continution character to <$contchar>");
}


##############################################################################
# SetContrepchar $string - sets the replace of the line continution char to
# something other than ""
##############################################################################
sub SetContrepchar
{
    $contrepchar = shift;
    Debug("Setting line continution replacement character to <$contrepchar>");
}


##############################################################################
# AddKeyword(keyword, function)
# Define a new keyword, when keyword (preceded by keyword char) is found,
# function is run on the remainder of the line.
##############################################################################
sub AddKeyword
{
    my $keyword = shift;
    my $function = shift;    
    $Keywords{$keyword} = $function;
    @Keywords = sort {$b cmp $a} (keys(%Keywords));
    Debug("Added keyword $keyword which runs $function");
}


##############################################################################
# RemoveKeyword(keyword)
# Keyword is deleted from list, all instatiations of keyword found in
# document are ignored.
##############################################################################
sub RemoveKeyword
{
    my $keyword = shift;
    delete $Keywords{$keyword};
    # sort keywords index into reverse order, this ensures #if[n]def comes
    # before #if when comparing input with keywords
    @Keywords = sort {$b cmp $a} (keys(%Keywords));
    Debug("Removed keyword $keyword");
}



##############################################################################
# RemoveAllKeywords - removes all current keywords.
##############################################################################
sub RemoveAllKeywords
{
    %Keywords = ();
    @Keywords = keys(%Keywords);
    Debug("Removed all current keywords");
}


##############################################################################
# UseModule(module)
# Module "module.pm" is used, "module.pm" can be any perl module and can use
# or replace any of the functions in this package
##############################################################################
sub UseModule
{
    my $module = shift;
    Debug("Loading module $module");
    require $module; 
    if($@) {
	Error($@);
    }
}


##############################################################################
# find end of next word in $sline, assumes leading whitespace removed
##############################################################################
sub GetNextWordEnd
{
    my $sline = shift;
    my $i;
    # check for space separting word and remainder of line
    $i = index($sline, " ");
    # space not found, check if word separated by tab
    if($i == -1) {
	$i = index($sline, "\t");
    }
    # assume word is last element on line
    if($i == -1) {
	$i = length($sline);
    }
    return $i;
}


##############################################################################
# Print current table of defines - used for debugging
##############################################################################
sub PrintDefines
{	
    my $i = 0;
    my $msg = "Current "."$keywordchar"."define's:";
    Debug($msg);
    while($Defines[$i]) {
        Debug("\t$i:\tmacro=\"$Defines[$i]\",");
        Debug("\t\tdefinition=\"$Defines{$Defines[$i]}\"");
        $i++;
    }
}


##############################################################################
# Find out if arguments have been used with macro
##############################################################################
sub DefineArgsUsed
{
    my $string = shift;
    # check '(' is first non-whitespace char after macro
    if($string =~ /^\s*\(/) {
	return 1;
    }
    return 0;
}


##############################################################################
# ParseArgs($string) -  find the arguments in a string of form
# (arg1, arg2, arg3...) trailing chars
# or
# arg1, arg2, arg3...
##############################################################################
sub ParseArgs
{
    my $string = shift;
    my @Chars;
    my $char;
    # split string into chars (can't use split coz it deletes \n at end)
    for($char=0; $char<length($string); $char++) {
	push(@Chars, substr($string, $char, 1));
    }
    my @Args;    # list of Args
    my $arg = "";
    my @Endchar;
    my $s = -1;  # start of chars
    
    # deal with first '(' if there (ie func(args) rather than func args)
    if($#Chars >= 0 && $Chars[0] eq '(') {
	push(@Endchar, ')');
	$Chars[0] = '';
	$s++;
    }

    # replace args with their values
    foreach $char (@Chars) {
	# deal with end of (),"",'' etc.
	if($#Endchar > -1 && $char eq $Endchar[$#Endchar])  {pop(@Endchar);}
	# deal with ()
	elsif($char eq '(')  {push(@Endchar, ')');}
	# deal with "" and ''
	elsif($char eq '"' || $char eq '\'')  {push(@Endchar, $char);}
	# deal with ',', add arg to hash and start search for next one
	elsif($#Endchar == $s && $char eq ',') {
	    push(@Args, CleanStartEnd($arg));
	    $char = '';
	    $arg = "";
	    next;
	}
	# check for end of args string
	if($#Endchar < $s) {
	    push(@Args, CleanStartEnd($arg));
	    $char = '';
	    # put remainder of string back together
	    $arg = join('', @Chars);
	    last;
	}
	$arg = $arg.$char; # add char to current arg
	$char = '';        # set char to null
    }
    
    # deal with last arg or string following args if it exists
    push(@Args, $arg);
    
    return @Args;
}


##############################################################################
# Find the arguments in a macro and replace them
##############################################################################
sub FindDefineArgs
{
    my $substring = shift;
    my $macro = shift;

    # get definition list for this macro
    my @Argnames = split(/\,/, $DefinesArgs{$macro});

    # get arguments passed to this macro
    my @Argvals;
    @Argvals = ParseArgs($substring);
    # check the right number of args have been passed, should be all args 
    # present plus string at end of args
    if($#Argvals != $#Argnames+1) {
	my $realargs = $#Argnames+1;
	Warning("macro \'$macro\' used with $#Argvals args, expected $realargs");
	my $lastarg = $Argvals[$#Argvals]; # get lastarg
	if($#Argvals < $#Argnames+1) {     # make all missing args blanks
	    $Argvals[$#Argvals] = "";
	    while($#Argvals < $#Argnames) {
		push(@Argvals, "");
	    }
	    push(@Argvals, $lastarg);
	}
	else {   # delete all excess args
	    while($#Argvals > $#Argnames) {
		pop(@Argvals);
	    }
	    push(@Argvals, $lastarg);
	}
    }
    
    # replace default args with supplied args
    my $i=0;
    for($i=0; $i<=$#Argvals; $i++) {
	# check if all args replaced
	if($i > $#Argnames)  {last;}
	$Argnames[$i] = $Argvals[$i];
    }
    
    # check for anything after function arglist and append it
    if($i > $#Argnames) {
	$Argnames[$i] = "";
	for(; $i<=$#Argvals; $i++) {
	    $Argnames[$i] = $Argnames[$i].$Argvals[$i];
	}
    }
    
    return @Argnames;
}


##############################################################################
# Replace all defined macro's arguments with their values
##############################################################################
sub ReplaceDefineArgs
{
    my $string = shift;
    my $macro = shift;
    # split up string to find arguments
    my @Substrings = split(/($macro)/, $string);
    my $substring;
    my $searching = 1;
    my $i = 0;
    foreach $substring (@Substrings) {
	# find macro in substrings
	if($searching) {
	    if($substring eq $macro) {
		$searching = 0;
	    }
	}
	# get arguments following macro
	else {
	    # check if args used, if not do nothing
	    if(DefineArgsUsed($substring)) {
		my @Argvals = FindDefineArgs($substring, $macro);
		my @Argnames = split(/\,/, $DefinesArgs{$macro});
		my $arg;
		my $j;
		
		# replace previous macro with defn + args
		$Substrings[$i-1] =~ s/$macro/$Defines{$macro}/g;
		for($j=0; $j<=$#Argnames; $j++) {
		    $Substrings[$i-1] =~ s/$Argnames[$j]/$Argvals[$j]/g;
		}
		# set rest current of string (non-args part)
		if(!$Argvals[$j]) {
		    $Argvals[$j] = "";
		}
		$substring = $Argvals[$j];
	    }
	    $searching = 1;
	}
	$i++;
    }
    # put string back together
    $string = "";
    foreach $substring (@Substrings) {
	$string = $string.$substring;
    }
    return $string;
}


##############################################################################
# Replace all defined macro's in a line with their value
##############################################################################
sub ReplaceDefines
{
    my $string = shift;
    my $check = "";
    my $last = "";
    my $macro;
    # run through define's as many times as needed - this is because there
    # may be define's within #define's.
    while($check ne $string) {
	$check = $string;
	# check line for any defined macros and replace
	foreach $macro (@Defines) {
	    my $temp = $string;
	    # try to avoid getting stuck in a recursive loop
	    if($last ne $macro) {
		# check if macro has arguments and is used in string
		if(CheckDefineArgs($macro)) {
		    if($string =~ /$macro/) {
			$string = ReplaceDefineArgs($string, $macro);
		    }
		}
		else {
		    $string =~ s/$macro/$Defines{$macro}/g;
		}
		if($string ne $temp) {
		    Debug("Replaced macro $macro");
		    $last = $macro;
		}
	    }
	}
    }
    return $string;
}


##############################################################################
# Set a define
##############################################################################
sub SetDefine
{
    my $macro = shift;
    my $value = shift;
    # add macro and value to hash table
    $Defines{$macro} = $value;
    # sort hash table into reverse order (this is done so "foobar" will be
    # replaced before "foo")
    @Defines = sort {$b cmp $a} (keys(%Defines));
}


##############################################################################
# Replace a define, checks if macro defined and only redefine's if it is
##############################################################################
sub Redefine
{
    my $macro = shift;
    my $value = shift;
    # check if defined
    if(CheckDefine($macro)) {
	SetDefine($macro, $value);
    }
}


##############################################################################
# Set a define argument list
##############################################################################
sub SetDefineArgs
{
    my $macro = shift;
    my $args = shift;
    # add macro args to hash table
    $DefinesArgs{$macro} = $args;
    # update hash table
    @DefinesArgs = keys(%DefinesArgs);
}


##############################################################################
# Check if a macro is defined
##############################################################################
sub CheckDefine
{
    my $macro = shift;
    return exists($Defines{$macro});
}


##############################################################################
# Check if a macro is defined and has arguments
##############################################################################
sub CheckDefineArgs
{
    my $macro = shift;
    return exists($DefinesArgs{$macro});
}


##############################################################################
# Test if a file exists and is readable
##############################################################################
sub FileExists
{
    my $filename = shift;
    # test if file is readable and not a directory
    if( !(-r $filename) || -d $filename ) {
	Debug("Checking for file: $filename...not found!");
	return 0;
    }
    Debug("Checking for file: $filename...found!");
    return 1;
}


##############################################################################
# #comment  - rest of line ignored as a comment
##############################################################################
sub Comment
{
    # nothing to be done here
    Debug("Commented line");
}


##############################################################################
# Define a variable, accepted inputs:
# $macrodefn = $macro $defn - $macro associated with $defn
#              ie: #define TEST test string
#              $macro = TEST, $defn = "test string"
#              Note: $defn = rest of line after $macro
# $macrodefn = $macro - $macro defined without a defn, rest of line ignored
#              ie: #define TEST_DEFINE
#              $macro = TEST_DEFINE, $defn = "1"
##############################################################################
sub Define
{
    my $macrodefn = shift;
    my $macro;
    my $defn;
    my $i;
    
    # find end of macroword - assume separated by space or tab
    $i = GetNextWordEnd($macrodefn);

    # separate macro and defn
    ($macro, $defn) = split(/\s/, $macrodefn, 2);

    # strip leading whitespace from $defn
    if($defn) {
	$defn = CleanStart($defn);
    }
    else {
	$defn = "";
    }

    # check if macro has arguments (will be a '(' in macro or at start of defn)
    if($macro =~ /\(/ || $defn =~ /^\(/) {
	# split up macro, args and defn - delimeters = space, (, ), ','
	my @arglist = split(/([\s,\(,\),\,])/, $macro." ".$defn);
	my $macroargs = "";
	my $arg;

	# macro is first element in list, remove it from list
	$macro = $arglist[0];
	$arglist[0] = "";
	# loop through list until ')' and find all args
	foreach $arg (@arglist) {
	    if($arg) {
		# end of arg list, leave loop
		if($arg eq ")") {
		    $arg = "";
		    last;
		}
		# ignore space, ',' and '('
		elsif($arg =~ /([\s,\,,\(])/) {
		    $arg = "";
		}
		# argument found, add to ',' separated list
		else {
		    $macroargs = $macroargs.",".$arg;
		    $arg = "";
		}
	    }
	}
	$macroargs = Strip($macroargs, ",", 1);
	# store args
	SetDefineArgs($macro, $macroargs);
	
	Debug("Define: macro $macro has args ($macroargs)");
	# put rest of defn back together
	$defn = "";
	foreach $arg (@arglist) {
	    $defn = $defn.$arg;
	}
	$defn = CleanStart($defn);
    }
    
    # define the macro defn pair
    SetDefine($macro, $defn);
    
    if($debug) {
	PrintDefines;
    }
}


##############################################################################
# Else, standard if[n][def]-else-endif
# usage: #else somewhere between #if[n][def] key and #endif
##############################################################################
sub Else
{
    # check #else is legal
    if($ifcount == 0) {
	my $fault = "$keywordchar"."else found without preceeding ".
	    "$keywordchar"."if[n][def]";
	Error($fault);
    }
    # reverse current #ifdef'ed status
    if($write == 0) {
	$write = 1;
    }
    else {
	$write = 0;
    }    
}


##############################################################################
# Endif, standard ifdef-[else]-endif
# usage: #endif somewhere after #ifdef key and optionally #else
##############################################################################
sub Endif
{
    # check #endif is legal
    if($ifcount == 0) {
	my $fault = "$keywordchar"."endif found without preceeding ".
	    "$keywordchar"."if[n][def]";
	Error($fault);
    }
    # turn off #ifdef'ing
    $write = 1;
    
    # decrement number of if blocks currently in
    $ifcount--;
}


##############################################################################
# If conditionally includes or ignores parts of a file based on expr
# usage: #if expr
# expr is evaluted to true(1) or false(0) and include usual ==, !=, > etc.
# style comparisons. The "defined" keyword can also be used, ie: 
# #if defined MACRO || !defined(MACRO)
##############################################################################
sub If
{
    my $expr = shift;
    my $indefined = 0;
    Debug("If: parsing: \"$expr\"");

    # split expr up into its component parts, the split is done on the
    # following list of chars and strings: '!','(',')','&&','||', whitespace
    my @exprs = split(/([\s,\!,\(,\)]|\&\&|\|\|)/, $expr);
    
    # search through parts for "defined" keyword and check if macros
    # are defined
    foreach $expr (@exprs) {
	if($indefined == 1) {
	    # previously found a defined keyword, check if next word
	    # could be the macro to test for (ie. not any of the listed chars)
	    if($expr && $expr !~ /([\s,\!,\(,\)]|\&\&|\|\|)/) {
		# replace macro with 0 or 1 depending if it is defined
		Debug("If: testing if \"$expr\" defined...");
		if(CheckDefine($expr)) {
		    $expr = 1;
		    Debug("If: defined");
		}
		else {
		    $expr = 0;
		    Debug("If: NOT defined");
		}
		$indefined = 0;
	    }	    
	}
	elsif($expr eq "defined") {
	    # get rid of defined keyword
	    $expr = "";
	    # search for next macro following "defined"
	    $indefined = 1;
	}
    }

    # put full expr string back together
    my $newexpr = "";
    foreach $expr (@exprs) {
	$newexpr = "$newexpr"."$expr";
    }
    
    # pass parsed line though RepaceDefines
    $expr = ReplaceDefines($newexpr);
    Debug("If: evaluating \"$expr\"");

    # evaluate line
    if(eval($expr)) {
	Debug("If: \"$expr\" true");
	$write = 1;
    }
    else {
	$write = 0;
	Debug("If: \"$expr\" false");
    }
    
    #increment number of #if[[n]def]'s currently in
    $ifcount++;
}


##############################################################################
# Elif equivalent to "else if".  Placed between #if[n][def] and #endif,
# equivalent to nesting #if's
##############################################################################
sub Elif
{
    my $input = shift;

    # check #else is legal
    if($ifcount == 0) {
	my $fault = "$keywordchar"."elif found without preceeding ".
	    "$keywordchar"."if[n][def]";
	Error($fault);
    }
    # decrement ifcount then call If (If will increment ifcount, it needs
    # to stay the same for Elif).
    $ifcount--;

    If($input);
}


##############################################################################
# Ifdef conditionally includes or ignores parts of a file based on macro,
# usage: #ifdef MACRO
# if macro has been previously #define'd everything following the
# #ifdef will be included, else it will be ignored until #else or #endif
##############################################################################
sub Ifdef
{
    my $macro = shift;
    
    # separate macro from any trailing garbage
    $macro = substr($macro, 0, GetNextWordEnd($macro));
    
    # check if macro defined - if not set to be #ifdef'ed out
    if(!CheckDefine($macro)) {
	$write = 0;
	Debug("Ifdef: $macro not defined");
    }
    else {
	Debug("Ifdef: $macro defined");
    }
    #increment number of #if[n]def's currently in
    $ifcount++;
}


##############################################################################
# Ifndef conditionally includes or ignores parts of a file based on macro,
# usage: #ifndef MACRO
# if macro has been previously #define'd everything following the
# #ifndef will be ignored, else it will be included until #else or #endif
##############################################################################
sub Ifndef
{
    my $macro = shift;

    # separate macro from any trailing garbage
    $macro = substr($macro, 0, GetNextWordEnd($macro));
    
    # check if macro defined - if not set to be #ifdef'ed out
    if(CheckDefine($macro)) {
	$write = 0;
	Debug("Ifndef: $macro defined");
    }
    else {
	Debug("Ifndef: $macro not defined");
    }
    
    #increment number of #if[n]def's currently in
    $ifcount++;
}


##############################################################################
# Include $filename in output file, format:
# #include "filename" - local include file, ie. in same directory, try -Ipath
#                       also if not not found in current directory
# #include <filename> - system include file, use -Ipath
##############################################################################
sub Include
{
    my $input = shift;
    my $filename = $input;
    my $fullname;
    my $sysinclude = 0;
    my $found = 0;
    my $i = 0;
    
    # replace any defined values in the include line
    $filename = ReplaceDefines($filename);

    # check if it is a system include file (#include <filename>) or a local 
    # include file (#include "filename")
    if(substr($filename, 0, 1) eq "<") {
	$sysinclude = 1;
	# remove <> from filename
	$filename = substr($filename, 1);
	if(substr($filename, -1) ne ">") {
	    Error("Missing closing \">\" for include: $input");
	}
	$filename = substr($filename, 0, -1);
    }
    else {
	# remove speechmarks from filename
	$filename = Strip($filename, "\"", 1);
    }

    # check for file in current directory
    if($sysinclude == 0) {
	if(FileExists($filename)) {
	    $fullname = $filename;
	    $found = 1;
	}
    }

    # search for file in include paths, first path on command line first
    while($found == 0 && $i < $num_includepaths) {
	$fullname = "$IncludePaths[$i]/$filename";
	if(FileExists($fullname)) {
	    $found = 1;
	}
	$i++;
    }
    
    # include file if found, error if not
    if($found == 1) {
	Debug("Including file: \"$fullname\"");
	# recurisvely call Parse
	Parse($fullname);
    }
    else {
	Error("Include file \"$filename\" not found");
    }
}



##############################################################################
# Pragma filepp Function Args
# Pragma executes a filepp function, everything following the function name
# is passed as arguments to the function.
# The format is:
# #pragma filepp function args...
# If pragma is not followed by "filepp", it is ignored.
##############################################################################
sub Pragma
{
    my $input = shift;
    
    # check for "filepp" in string
    if($input =~ /^filepp/) {
	my ($function, $args);
	($input, $function, $args) = split(/\s/, $input, 3);
	if($function) {
	    if(!$args) { $args = ""; }
	    if($safe_mode) {
		Debug("Safe mode enabled, NOT running: $function($args)");
	    }
	    else {
		my @Args = ParseArgs($args);
		Debug("Running function: $function($args)");
		$function->(@Args);
	    }
	}
    }
}


##############################################################################
# Undef a previously defined variable, usage:
# #undef $macro
##############################################################################
sub Undef
{
    my $macro = shift;
    my $i;
    
    # separate macro from any trailing garbage
    $macro = substr($macro, 0, GetNextWordEnd($macro));
    
    # delete macro from table
    delete $Defines{$macro};
    @Defines = keys(%Defines);
    
    if($debug) {
	PrintDefines;
    }
}


##############################################################################
# UndefAll - undefines ALL macros
##############################################################################
sub UndefAll
{
    %Defines = ();
    @Defines = keys(%Defines);
    if($debug) {
	PrintDefines;
    }
}


##############################################################################
# #warning msg  - print warning message "msg"
##############################################################################
sub Warning
{
    my $msg = shift;
    my $lastdebug = $debug;
    $debug = 1;
    Debug($msg);
    $debug = $lastdebug;
}


##############################################################################
# GetNextLine - returns the next line of the current INPUT line,
# line contiuation is taken care of here.
##############################################################################
sub GetNextLine
{
    local *INPUT = shift;
    my $thisline = <INPUT>;
    if($thisline) {
	Redefine("__LINE__", ++$line);
	# check if end of line has a continution char, if it has get next line
	while($thisline =~ /$contchar$/) {
	    # remove backslash and newline
	    $thisline =~ s/$contchar\n\Z//g;
	    Debug("Line continuation");
	    # get next line and append to current
	    my $nextline = <INPUT>;
	    if(!$nextline) {
		return $thisline;
	    }
	    $thisline = "$thisline"."$contrepchar"."$nextline";
	    # increment line count
	    Redefine("__LINE__", ++$line);
	}
    }
    return $thisline;
}


##############################################################################
# Write($string) - writes $string to OUTPUT file
##############################################################################
sub Write
{
    my $string = shift;
    print(OUTPUT $string);
}


##############################################################################
# Main parsing routine
##############################################################################
sub Parse
{
    # change file being parsed to this file, remember last filename so
    # it can be returned at the end
    my $lastparse = $file;
    $file = shift;

    Debug("Parsing $file...");
    Redefine("__FILE__", $file);
    
    # reset linecount, remembering previous count for future reference
    my $lastcount = $line;
    $line = 0;
    Redefine("__LINE__", $line);
    
    # increment include level
    Redefine("__INCLUDE_LEVEL__", ++$include_level);
    
    # open file and set its handle to INPUT
    local *INPUT;
    if(!open(INPUT, $file)) {
	Error("Could not open file $file");
    }
    
    # parse each line of file
    $_ = GetNextLine(*INPUT);
    while($_) {
  	my $thisline = $_;	
	my $found = 0;
	my $keyword;
	# remove whitespace from start of line
	$thisline = CleanStart($thisline);
	# check if first char on line is a #
	if($thisline && $thisline =~ /^$keywordchar/) {
	    # remove "#" and any following whitespace
	    $thisline =~ s/^$keywordchar//g;
	    $thisline = CleanStart($thisline);
	    # parse line for keywords
	    foreach $keyword (@Keywords) {
		if($thisline && $thisline =~ /^$keyword/) {
		    $found = 1;
		    # remove newline from line
		    chomp($thisline);
		    # remove leading whitespace and keyword from line
		    my $input = CleanStart(substr($thisline,length($keyword)));
		    # if currently #ifdef'ed out, only accept #else #elif
		    # and #endif
		    if($write == 0) {
			if($ifwrite == 0 && (
			   $keyword eq "else"  ||
			   $keyword eq "endif" ||
			   $keyword eq "elif")) {
			    $Keywords{$keyword}->($input);
			}
			# reached an endif in an if'ed out section
			elsif($ifwrite > 0 && $keyword eq "endif") {
			    $ifwrite--;
			}
			# check for #if[n][def] hidden in if'ed out section
			elsif($keyword eq "if"    ||
			      $keyword eq "ifdef" ||
			      $keyword eq "ifndef") {
			    $ifwrite++;
			}
		    }
		    else {
			# run function associated with this keyword
			$Keywords{$keyword}->($input);
		    }
		    last;
		}
	    }
	}
	# no keywords in line - write line to file if not #ifdef'ed out
	if($found == 0 && $write == 1) {
	    # check for #define'd keys in line and replace with values
	    $_ = ReplaceDefines($_);
	    # write output to file or STDOUT
	    Write($_);
	}
	$_ = GetNextLine(*INPUT);
    }
    # close file
    close(INPUT);
    Debug("Parsing $file done. ($line lines processed)");

    # reset $line
    $line = $lastcount;
    Redefine("__LINE__", $line);

    # reset $file
    $file = $lastparse;
    Redefine("__FILE__", $file);
    if($file ne "") {
	Debug("Parsing returned to $file at line $line");
    }
    
    # decrement include level
    Redefine("__INCLUDE_LEVEL__", --$include_level);
}


##############################################################################
# Main routine
##############################################################################

# parse command line
my $i=0;
my $argc=0;
while($ARGV[$argc]) {
    $argc++;
}

while($ARGV[$i]) {

    # read from stdin instead of file
    if($ARGV[$i] eq "-c") {
	$input_stdin = 1;
    }
    
    # Defines: -Dmacro[=defn] or -D macro[=defn]
    elsif(substr($ARGV[$i], 0, 2) eq "-D") {
	my $macrodefn;
	# -D macro[=defn] format
	if(length($ARGV[$i]) == 2) {
	    if($i+1 >= $argc) {
		Error("Argument to `-D' is missing");
	    }
	    $macrodefn = $ARGV[++$i];
	}
	# -Dmacro[=defn] format
	else {
	    $macrodefn = substr($ARGV[$i], 2);
	}
	my $macro = $macrodefn;
	my $defn = "";
	my $j = index($macrodefn, "=");
	if($j > -1) {
	    $defn  = substr($macrodefn, $j+1);
	    $macro = substr($macrodefn, 0, $j);
	}
	$macrodefn = $macro." ".$defn;
	# add macro and defn to hash table
	Define($macrodefn);
    }

    # Debugging turned on: -d
    elsif($ARGV[$i] eq "-d") {
	$debug = 1;
    }

    # show help
    elsif($ARGV[$i] eq "-h") {
	print(STDERR "$usage");
	exit(0);
    }

    # Include paths: -Iinclude or -I include
    elsif(substr($ARGV[$i], 0, 2) eq "-I") {
	# -I include format
	if(length($ARGV[$i]) == 2) {
	    if($i+1 >= $argc) {
		Error("Argument to `-I' is missing");
	    }
	    $IncludePaths[$num_includepaths++] = $ARGV[++$i];
	}
	# -Iinclude format
	else {
	    $IncludePaths[$num_includepaths++] = substr($ARGV[$i], 2);
	}
    }

    # turn off keywords
    elsif($ARGV[$i] eq "-k") {
	RemoveAllKeywords();
    }

    # set keyword prefix char
    elsif($ARGV[$i] eq "-kc") {
	if($i+1 >= $argc) {
	    Error("Argument to `-kc' is missing");
	}
	SetKeywordchar($ARGV[++$i]);
    }

    # set line continuation character
    elsif($ARGV[$i] eq "-lc") {
	if($i+1 >= $argc) {
	    Error("Argument to `-lc' is missing");
	}
	SetContchar($ARGV[++$i]);
    }

    # set line continuation replacement char to newline
    elsif($ARGV[$i] eq "-lrn") {
	SetContrepchar("\n");
    }

    # set line continuation replacement character
    elsif($ARGV[$i] eq "-lr") {
	if($i+1 >= $argc) {
	    Error("Argument to `-lr' is missing");
	}
	SetContrepchar($ARGV[++$i]);
    }

    # use module
    elsif($ARGV[$i] eq "-m") {
	if($i+1 >= $argc) {
	    Error("Argument to `-m' is missing");
	}
	UseModule("$ARGV[++$i]");
    }
    
    # Output filename: -o filename or -ofilename
    elsif(substr($ARGV[$i], 0, 2) eq "-o") {
	# -o filename
	if(length($ARGV[$i]) == 2) {
	    if($i+1 >= $argc) {
		Error("Argument to `-I' is missing");
	    }
	    $outputfile = $ARGV[++$i];
	}
	# -ofilename
	else {
	    $outputfile = substr($ARGV[$i], 2);
	}
    }
    
    # Safe mode - turns off #pragma
    elsif($ARGV[$i] eq "-s") {
	SafeMode();
    }

    # Undefine all macros
    elsif($ARGV[$i] eq "-u") {
	UndefAll();
    }

    # print version number and exit
    elsif($ARGV[$i] eq "-v") {
	print(STDERR "filepp version $VERSION\n");
	exit(0);
    }
    
    # default - an input file name
    else {
	if(!FileExists($ARGV[$i])) {
	    Error("Input file \"$ARGV[$i]\" not readable");
	}
	$Inputfiles[$num_inputfiles++] = $ARGV[$i];
    }

    $i++;
}

# print info from command line if debugging
if($debug) {
    for($i=0; $i<$num_includepaths; $i++) {
	Debug("Include path $i: \"$IncludePaths[$i]\"");
    }
    PrintDefines;
    Debug("Output file: $outputfile");
    for($i=0; $i<$num_inputfiles; $i++) {
	Debug("Input file $i: \"$Inputfiles[$i]\"");
    }    
}

# check for outputfile name, if not specified use STDOUT
if($outputfile eq "") {
    $outputfile = "-";
    $output_stdout = 1;
}

# open output file if specified, if only one input and output, and
# they have the same name, rename the input to input~
if($num_inputfiles == 1 && $outputfile eq $Inputfiles[0]) {
    # paranoid check file is writable and normal file
    if(-w $outputfile && -f $outputfile) {
	$outputfile = "$outputfile.fpp$$";
	$same_file = 1;
    }
    else {
	Error("Cannot read and write to $outputfile");
    }
}
# check input filename is not same as output - will destroy input file
for($i=0; $i<$num_inputfiles; $i++) {
    if($outputfile eq $Inputfiles[$i]) {
	Error("Output file cannot have same name as input file!");
    }
}
if(!open(OUTPUT, ">$outputfile")) {
    Error("Cannot open output file: $outputfile");
}

if($input_stdin == 1) {
    Parse("-");
}
else {
    # check input files have been specified
    if($num_inputfiles == 0) {
	Error("No input files given");
    }
    
    # parse all input files in order given on command line
    for($i=0; $i<$num_inputfiles; $i++) {
	$base_file = $Inputfiles[$i];
	Redefine("__BASE_FILE__", $base_file);
	Parse($Inputfiles[$i]);
    }
}

# close output file
close(OUTPUT);

# if input and output have same name, rename output to input now
if($same_file == 1) {
    if(rename($Inputfiles[0], "$Inputfiles[0]~") == -1) {
	Error("Could not rename $Inputfiles[0] $Inputfiles[0]~");
    }
    if(rename($outputfile, $Inputfiles[0]) == -1) {
	Error("Could not rename $outputfile $Inputfiles[0]");
    }
}

exit(0);

# Hey emacs !!
# Local Variables:
# mode: perl
# End:
