#!/usr/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$ # Author : $Author$ # Maintainer : Darren Miller: darren@cabaret.demon.co.uk # File version : $Revision$ # Last changed : $Date$ # Description : Main program # Licence : GNU copyleft # ######################################################################## package Filepp; use strict "vars"; use strict "subs"; # Used to all filepp to work with any char, not just ascii, # feel free to remove this if it causes you problems use bytes; # version number of program my $VERSION = '1.7.1'; # list of paths to search for modules, normal Perl list + module dir push(@INC, "/usr/local/share/filepp/modules"); # 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 ); # set of functions which process the file in the Parse routine. # Processors are functions which take in a line and return the processed line. # Note: this is done as a string rather than pointer to a function because # it makes list easier to modify/remove from/print. my @Processors = ( "Filepp::ParseKeywords", "Filepp::ReplaceDefines" ); # processor types say what the processor should be run on: choice is: # 0: Everything (default) # 1: Full lines only (lines originating from Parse function) # 2: Part lines only (lines originating from within keywords, eg: # #if "condition", "condition" is a part line) my %ProcessorTypes = ( 'Filepp::ParseKeywords' => 1, 'Filepp::ReplaceDefines' => 0 ); # functions to run each time a new base input file is opened or closed my @OpenInputFuncs = (); my @CloseInputFuncs = (); # functions to run each time a new output file is opened or closed my @OpenOutputFuncs = (); my @CloseOutputFuncs = (); # safe mode is for the paranoid, when enabled turns off #pragma filepp, # enabled by default my $safe_mode = 0; # test for shebang mode, used for "filepp script", ie. executable file with # "#!/usr/bin/perl /usr/local/bin/filepp" at the top my $shebang = 1; # allow $keywordchar, $contchar, $optlineendchar and $macroprefix # to be perl regexps my $charperlre = 0; # character(s) which prefix environment variables - defaults to shell-style '$' my $envchar = "\$"; # boolean determining whether line continuation is implicit if there are more # open brackets than close brackets on a line # disabled by default my $parselineend = \&Filepp::ParseLineEnd; # character(s) which replace continuation char(s) - defaults to C-style nothing my $contrepchar = ""; # character(s) which prefix keywords - defaults to C-style '#' my $keywordchar; if($charperlre) { $keywordchar = "\#"; } else { $keywordchar = "\Q#\E"; } # character(s) which signifies continuation of a line - defaults to C-style '\' my $contchar; if($charperlre) { $contchar = "\\\\"; } else { $contchar = "\Q\\\E"; } # character(s) which optionally signifies the end of a line - # defaults to empty string '' my $optlineendchar = ""; # character(s) which prefix macros - defaults to nothing my $macroprefix = ""; # flag to use macro prefix in keywords (on by default) my $macroprefixinkeywords = 1; # check if macros must occur as words when replacing, set this to '\b' if # you prefer cpp style behaviour as default my $bound = ''; # number of line currently being parsed (int) my $line = 0; # file currently being parsed my $file = ""; # list of input files my @Inputfiles; # list of files to include macros from my @Imacrofiles; # flag to control when output is written my $output = 1; # name of outputfile - defaults to STDOUT my $outputfile = ""; # overwrite mode - automatically overwrites old file with new file my $overwrite = 0; # overwrite conversion mode - conversion from input filename to output filename my $overwriteconv = ""; # list of keywords which have "if" functionality my %Ifwords = ('if', '', 'ifdef', '', 'ifndef', ''); # list of keywords which have "else" functionality my %Elsewords = ('else', '', 'elif', ''); # list of keywords which have "endif" functionality my %Endifwords = ('endif', ''); # current level of include files my $include_level = -1; # suppress blank lines in header files (indexed by include level) my $blanksuppopt = 0; my @blanksupp; # try to keep same number lines in output file as input file my $preserveblank = 0; # counter of recursion level for detecting recursive macros my $recurse_level = -1; # debugging info, 1=on, 0=off my $debug = 0; # send debugging info to stdout rather than stderr my $debugstdout = 0; # debug prefix character or string my $debugprefix = ""; # debug postfix character or string my $debugpostfix = "\n"; # hash of macros defined - standard ones already included my %Defines = ( '__BASE_FILE__' => "", '__DATE__' => "", '__FILEPP_INPUT__' => "Generated automatically from __BASE_FILE__ by filepp", '__FILE__' => $file, '__INCLUDE_LEVEL__' => $include_level, '__ISO_DATE__' => "", '__LINE__' => $line, '__NEWLINE__' => "\n", '__NULL__' => "", '__TAB__' => "\t", '__TIME__' => "", '__VERSION__' => $VERSION ); # hash of first chars in each macro my %DefineLookup; # length of longest and shortest define my ($defmax, $defmin); GenerateDefinesKeys(); # set default values for date and time { # conversions of month number into letters (0-11) my @MonthChars = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); #prepare standard defines my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isbst) = localtime(time()); $year += 1900; $sec = sprintf("%02d", $sec); $min = sprintf("%02d", $min); $hour = sprintf("%02d", $hour); $mday = sprintf("%02d", $mday); $mon = sprintf("%02d", $mon); Redefine("__TIME__", $hour.":".$min.":".$sec); Redefine("__DATE__", $MonthChars[$mon]." ".$mday." ".$year); $mon = sprintf("%02d", ++$mon); Redefine("__ISO_DATE__", $year."-".$mon."-".$mday); } # hash table for arguments to macros which need them my %DefinesArgs = (); # hash table for functions which macros should call (if any) my %DefinesFuncs = (); # eat-trailing-whitespace flag for each macro my %EatTrail = (); # list of include paths my @IncludePaths; # help string my $usage = "filepp: generic file preprocessor, version ".$VERSION." usage: filepp [options] inputfile(s) options: -b\t\tsuppress blank lines from include files -c\t\tread input from STDIN instead of file -Dmacro[=defn]\tdefine macros (same as #define) -d\t\tprint debugging information -dd\t\tprint verbose debugging information -dl\t\tprint some (light) debugging information -dpre char\tprefix all debugging information with char -dpost char\tpostfix all debugging information with char, defaults to newline -ds\t\tsend debugging info to stdout rather than stderr -e\t\tdefine all environment variables as macros -ec char\tset environment variable prefix char to \"char\" (default \$) -ecn\t\tset environment variable prefix char to nothing (default \$) -h\t\tprint this help message -Idir\t\tdirectory to search for include files -imacros file\tread in macros from file, but discard rest of file -k\t\tturn off parsing of all keywords, just macro expansion is done -kc char\tset keyword prefix char to \"char\" (defaults to #) -lc char\tset line continuation character to \"char\" (defaults to \\) -lec char\tset optional keyword line end char to \"char\" -lr char\tset line continuation replacement character to \"char\" -lrn\t\tset line continuation replacement character to newline -m module\tload module -mp char\tprefix all macros with \"char\" (defaults to no prefix) -mpnk\t\tdo not use macro prefix char in keywords -Mdir\t\tdirectory to search for filepp modules -o output\tname of output file (defaults to stdout) -ov\t\toverwrite mode - output file will overwrite input file -ovc IN=OUT\toutput file(s) will have be input file(s) with IN conveted to OUT -pb\t\tpreseve blank lines in output that would normally be removed -s\t\trun in safe mode (turns off pragma keyword) -re\t\ttreat keyword and macro prefixes and line cont chars as reg exps -u\t\tundefine all predefined macros -v\t\tprint version and exit -w\t\tturn on word boundaries when replacing macros all other arguments are assumed to be input files "; ############################################################################## # SetDebug - controls debugging level ############################################################################## sub SetDebug { $debug = shift; Debug("Debugging level set to $debug", 1); } ############################################################################## # Debugging info ############################################################################## sub Debug { # print nothing if not debugging if($debug == 0) { return; } my $msg = shift; my $level = 1; # check if level has been provided if($#_ > -1) { $level = shift; } if($level <= $debug) { # 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; } if($debugstdout) { print(STDOUT $debugprefix.$msg.$debugpostfix); } else { print(STDERR $debugprefix.$msg.$debugpostfix); } } } ############################################################################## # 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($outputfile ne "-") { # output is not stdout my $inputfile; my $found = 0; # do paranoid check to make sure we are not deleting an input file foreach $inputfile (@Inputfiles) { if($outputfile eq $inputfile) { $found = 1; last; } } # delete output file if($found == 0) { unlink($outputfile); } } # print error message $debug = 1; Debug($msg, 0); exit(1); } ############################################################################## # SafeMode - turns safe mode on ############################################################################## sub SafeMode { $safe_mode = 1; Debug("Filepp safe mode enabled", 2); } ############################################################################## # CleanStart($sline) - strip leading whitespace from start of $sline. ############################################################################## sub CleanStart { my $sline = shift; for($sline) { # '^' = start of line, '\s+' means all whitespace, replace with nothing s/^\s+//; } 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/\A([$char]{0,$level})//g; # strip trailing chars from line $sline =~ s/([$char]{0,$level})\Z//g; return $sline; } ############################################################################## # SetMacroPrefix $string - prefixs all macros with $string ############################################################################## sub SetMacroPrefix { $macroprefix = shift; # make sure prefix will not be treated as a Perl regular expression if(!$charperlre) { $macroprefix = "\Q$macroprefix\E"; } Debug("Setting macro prefix to <".$macroprefix.">", 2); } ############################################################################## # SetKeywordchar $string - sets the first char(s) of each keyword to # something other than "#" ############################################################################## sub SetKeywordchar { $keywordchar = shift; # make sure char will not be treated as a Perl regular expression if(!$charperlre) { $keywordchar = "\Q$keywordchar\E"; } Debug("Setting keyword prefix character to <".$keywordchar.">", 2); } ############################################################################## # GetKeywordchar - returns the current keywordchar ############################################################################## sub GetKeywordchar { return $keywordchar; } ############################################################################## # SetContchar $string - sets the line continuation char to something other # than "\" ############################################################################## sub SetContchar { $contchar = shift; # make sure char will not be treated as a Perl regular expression if(!$charperlre) { $contchar = "\Q$contchar\E"; } Debug("Setting line continuation character to <".$contchar.">", 2); } ############################################################################## # SetContrepchar $string - sets the replace of the line continuation char to # something other than "" ############################################################################## sub SetContrepchar { $contrepchar = shift; Debug("Setting line continuation replacement character to <".$contrepchar.">", 2); } ############################################################################## # SetOptLineEndchar $string - sets the optional line end char to something # other than "" ############################################################################## sub SetOptLineEndchar { $optlineendchar = shift; # make sure char will not be treated as a Perl regular expression if(!$charperlre) { $optlineendchar = "\Q$optlineendchar\E"; } Debug("Setting optional line end character to <".$optlineendchar.">", 2); } ############################################################################## # SetEnvchar $string - sets the first char(s) of each defined environment # variable to $string - NOTE: change only takes effect when DefineEnv run ############################################################################## sub SetEnvchar { $envchar = shift; Debug("Setting environment variable prefix character to <".$envchar.">",2); } ############################################################################## # RunProcessors $string, $calledfrom # run the current processing chain on the string # $string is the string to be processed and should be returned by the processor # $calledfrom says where the processors are called from, the choice is: # # 0 or default: Part line (from within a keyword) - if called recursively # runs all processors AFTER current processor, then continues with processing. # This is used when a keyword want to run all remaining processors on a line # before doing its keyword task. # # 1: Full line (from Parse function) - if called recursively runs all # processors BEFORE current processor, then continues with processing # # 2: Part line (from within a keyword) - if called recursively runs all # processors BEFORE current processor, then continues with processing. # This is used when keywords are using text taken from somewhere other than # the current line, this text needs to go through the same processors as # the current line has been through so it can "catch up" (eg: regexp.pm). # ############################################################################## my @Running; my @Currentproc; sub RunProcessors { my $string = shift; my $calledfrom = 0; if($#_ > -1) { $calledfrom = shift; } my $i; # turn off macoprefix if in a keyword my $tmpprefix = ""; if($calledfrom != 1 && $macroprefixinkeywords == 0) { $tmpprefix = $macroprefix; $macroprefix = ""; } # These tests are done to make RunProcessors recursion safe. # If RunProcessors is called from with a function that was itself called # by RunProcessors, then the second calling of RunProcessors will only # execute the processors before the currently running processor in the # chain. my $recursing = 0; my $firstproc = 0; my $lastproc = $#Processors; if($Running[$include_level]) { if($calledfrom == 0) { $firstproc = $Currentproc[$include_level] + 1; } else { $lastproc = $Currentproc[$include_level] - 1; } $recursing = 1; } else { $Running[$include_level] = 1; } for($i = $firstproc; $i <= $lastproc; $i++) { if(!$recursing) { $Currentproc[$include_level] = $i; } # called from anywhere (default) if($ProcessorTypes{$Processors[$i]} == 0 || # called from keyword (part lines only - within keywords) (($calledfrom == 0 || $calledfrom == 2) && $ProcessorTypes{$Processors[$i]} == 2) || # called from Parse function (whole lines only) ($calledfrom == 1 && $ProcessorTypes{$Processors[$i]} == 1)) { # run processor # Debug("Running processor $Processors[$i] on \"$string\"", 2); $string = $Processors[$i]->($string); } # check that no processors have been deleted (bigdef.pm) if($lastproc > $#Processors) { $lastproc = $#Processors; } } if(!$recursing) { $Running[$include_level] = 0; } # return macro prefix to its former glory if($calledfrom != 1 && $macroprefixinkeywords == 0) { $macroprefix = $tmpprefix; } return $string; } ############################################################################## # PrintProcessors # print the current processing chain ############################################################################## sub PrintProcessors { my $processor; Debug("Current processing chain:", 3); my $i = 0; foreach $processor (@Processors) { Debug($processor." type ".$ProcessorTypes{$Processors[$i]}, 3); $i++; } } ############################################################################## # AddProcessor(function[, first[, type]]) # add a line processor to processing chain, defaults to end of chain # if "first" is set to one adds processor to start of chain ############################################################################## sub AddProcessor { my $function = shift; my $first = 0; my $type = 0; # check if flag to add processor to start of chain is set if($#_ > -1) { $first = shift; } # check if processor has a type if($#_ > -1) { $type = shift; } # adding processor to start of chasin if($first) { @Processors = reverse(@Processors); } push(@Processors, $function); if($first) { @Processors = reverse(@Processors); } $ProcessorTypes{$function} = $type; Debug("Added processor ".$function." of type ".$type, 2); if($debug > 1) { PrintProcessors(); } } ############################################################################## # AddProcessorAfter(function, processor[, type]) # add a line processor to processing chain immediately after an existing # processor, if existing processor not found, new processor is added to # end of chain ############################################################################## sub AddProcessorAfter { my $function = shift; my $existing = shift; my $type = 0; # check if processor has a type if($#_ > -1) { $type = shift; } my $i = 0; my $found = 0; my @CurrentProcessors = @Processors; my $processor; # reset processing chain @Processors = (); foreach $processor (@CurrentProcessors) { push(@Processors, $processor); if(!$found) { # check done as regular expression for greater flexibility if($processor =~ /$existing/) { push(@Processors, $function); $found = 1; } } } if(!$found) { Warning("Did not find processor $existing in chain, processor $processor added to end of list"); AddProcessor($function, 0, $type); return; } $ProcessorTypes{$function} = $type; Debug("Added processor ".$function." of type ".$type, 2); if($debug > 1) { PrintProcessors(); } } ############################################################################## # AddProcessorBefore(function, processor[, type]) # add a line processor to processing chain immediately after an existing # processor, if existing processor not found, new processor is added to # end of chain ############################################################################## sub AddProcessorBefore { my $function = shift; my $existing = shift; my $type = 0; # check if processor has a type if($#_ > -1) { $type = shift; } my $i = 0; my $found = 0; my @CurrentProcessors = @Processors; my $processor; # reset processing chain @Processors = (); foreach $processor (@CurrentProcessors) { if(!$found) { # check done as regular expression for greater flexibility if($processor =~ /$existing/) { push(@Processors,$function); $found = 1; } } push(@Processors, $processor); } if(!$found) { Warning("Did not find processor $existing in chain, processor $processor added to start of list"); AddProcessor($function, 1, $type); return; } $ProcessorTypes{$function} = $type; Debug("Added processor ".$function." of type ".$type, 2); if($debug > 1) { PrintProcessors(); } } ############################################################################## # RemoveProcessor(function) # remove a processor name "function" from list ############################################################################## sub RemoveProcessor { my $function = shift; my $i = 0; # find function while($i <= $#Processors && $Processors[$i] ne $function) { $i++; } # check function found if($i > $#Processors) { Warning("Attempt to remove function ".$function. " which does not exist"); return; } # remove function for(; $i<$#Processors; $i++) { $Processors[$i] = $Processors[$i+1]; } pop(@Processors); delete($ProcessorTypes{$function}); Debug("Removed processor ".$function, 2); PrintProcessors(); } ############################################################################## # Add a function to run each time a base file is opened ############################################################################## sub AddOpenInputFunc { my $func = shift; push(@OpenInputFuncs, $func); } ############################################################################## # Add a function to run each time a base file is closed ############################################################################## sub AddCloseInputFunc { my $func = shift; push(@CloseInputFuncs, $func); } ############################################################################## # Add a function to run each time a base file is opened ############################################################################## sub AddOpenOutputFunc { my $func = shift; push(@OpenOutputFuncs, $func); } ############################################################################## # Add a function to run each time a base file is closed ############################################################################## sub AddCloseOutputFunc { my $func = shift; push(@CloseOutputFuncs, $func); } ############################################################################## # 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; Debug("Added keyword ".$keyword." which runs ".$function, 2); } ############################################################################## # RemoveKeyword(keyword) # Keyword is deleted from list, all occurrences 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 Debug("Removed keyword ".$keyword, 2); } ############################################################################## # RemoveAllKeywords - removes all current keywords. ############################################################################## sub RemoveAllKeywords { %Keywords = (); Debug("Removed all current keywords", 2); } ############################################################################## # AddIfword - adds a keyword to ifword hash ############################################################################## sub AddIfword { my $ifword = shift; $Ifwords{$ifword} = ''; Debug("Added Ifword: ".$ifword, 2); } ############################################################################## # RemoveIfword - removes a keyword from ifword hash ############################################################################## sub RemoveIfword { my $ifword = shift; delete $Ifwords{$ifword}; Debug("Removed Ifword: ".$ifword, 2); } ############################################################################## # AddElseword - adds a keyword to elseword hash ############################################################################## sub AddElseword { my $elseword = shift; $Elsewords{$elseword} = ''; Debug("Added Elseword: ".$elseword, 2); } ############################################################################## # RemoveElseword - removes a keyword from elseword hash ############################################################################## sub RemoveElseword { my $elseword = shift; delete $Elsewords{$elseword}; Debug("Removed Elseword: ".$elseword, 2); } ############################################################################## # AddEndifword - adds a keyword to endifword hash ############################################################################## sub AddEndifword { my $endifword = shift; $Endifwords{$endifword} = ''; Debug("Added Endifword: ".$endifword, 2); } ############################################################################## # RemoveEndifword - removes a keyword from endifword hash ############################################################################## sub RemoveEndifword { my $endifword = shift; delete $Endifwords{$endifword}; Debug("Removed Endifword: ".$endifword, 2); } ############################################################################## # AddIncludePath - adds another include path to the list ############################################################################## sub AddIncludePath { my $path = shift; push(@IncludePaths, $path); Debug("Added include path: \"".$path."\"", 2); } ############################################################################## # AddModulePath - adds another module search path to the list ############################################################################## sub AddModulePath { my $path = shift; push(@INC, $path); Debug("Added module path: \"".$path."\"", 2); } # set if file being written to has same name as input file my $same_file = ""; ############################################################################## # OpenOutputFile - opens the output file ############################################################################## sub OpenOutputFile { $outputfile = shift; Debug("Output file: ".$outputfile, 1); # check for outputfile name, if not specified use STDOUT if($outputfile eq "") { $outputfile = "-"; } # output is not stdout and file with that name already exists if($outputfile ne "-" && FileExists($outputfile) ) { $same_file = $outputfile; # paranoid: check file is writable and normal file if(-w $outputfile && -f $outputfile) { $outputfile = $outputfile.".fpp".$$; my $i=0; # paranoid: check temp file does not exist while(FileExists($outputfile)) { $outputfile = $outputfile.$i; $i++; if($i >= 10) { Error("Cound not get temp filename"); } } } else { Error("Cannot read or write to ".$outputfile); } } if(!open(OUTPUT, ">".$outputfile)) { Error("Cannot open output file: ".$outputfile); } # run any open functions my $func; foreach $func (@OpenOutputFuncs) { $func->(); } } ############################################################################## # CloseOutputFile - close the output file ############################################################################## sub CloseOutputFile { # run any close functions my $func; foreach $func (@CloseOutputFuncs) { $func->(); } close(OUTPUT); # if input and output have same name, rename output to input now if($same_file ne "") { if(rename($same_file, $same_file."~") == -1) { Error("Could not rename ".$same_file." ".$same_file."~"); } if(rename($outputfile, $same_file) == -1) { Error("Could not rename ".$outputfile." ".$same_file); } } # reset same_file $same_file = ""; } ############################################################################## # ChangeOutputFile - change the output file ############################################################################## sub ChangeOutputFile { CloseOutputFile(); $outputfile = shift; OpenOutputFile($outputfile); } ############################################################################## # AddInputFile - adds another input file to the list ############################################################################## sub AddInputFile { my $file = shift; push(@Inputfiles, $file); Debug("Added input file: \"".$file."\"", 2); } ############################################################################## # 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, 1); require $module; if($@) { Error($@); } } ############################################################################## # find end of next word in $sline, assumes leading whitespace removed ############################################################################## sub GetNextWordEnd { my $sline = shift; # check for whitespace in this string if($sline =~ /\s/) { # return length of everything up to first whitespace return length($`); } # whitespace not found, return length of the whole string return length($sline); } ############################################################################## # Print current table of defines - used for debugging ############################################################################## sub PrintDefines { my $define; Debug("Current ".$keywordchar."define's:", 3); foreach $define (keys(%Defines)) { Debug(" macro:\"".$define."\", definition:\"".$Defines{$define}."\"",3); } } ############################################################################## # DefineEnv - define's all environment variables to macros, each prefixed # by $envchar ############################################################################## sub DefineEnv { my $macro; Debug("Defining environment variables as macros", 2); foreach $macro (keys(%ENV)) { Define($envchar.$macro." ".$ENV{$macro}); } } ############################################################################## # 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; $string = CleanStart($string); my @Chars; my $char; # split string into chars (can't use split coz it deletes \n at end) for($char=0; $char ')', '"' => '"', '\'' => '\''); my $s = -1; # start of chars my $backslash = 0; # number of special char pairs to allow my $pairs = 1; # deal with first '(' if there (ie func(args) rather than func args) if($#Chars >= 0 && $Chars[0] eq '(') { push(@Endchar, ')'); $Chars[0] = ''; $s++; $pairs++; # ignore this pair of special char pairs } # replace args with their values foreach $char (@Chars) { # deal with end of special chars, ),",' etc. if($#Endchar > -1 && $char eq $Endchar[$#Endchar]) { # if char before this was a backslash, ignore this char if($backslash) { chop($arg); # delete backslash from string } else { # pop end char of list and reduce pairs if its a bracket if(pop(@Endchar) eq ')') { $pairs--; } } } # deal with start of special chars elsif(exists($SpecialChars{$char})) { # if char before this was a backslash, ignore this char if($backslash) { chop($arg); # delete backslash from string } # only start new pair if not already in special char pair # (not including main args brackets of course) elsif($#Endchar < $pairs-1) { push(@Endchar, $SpecialChars{$char}); # need to treat brackets differently for macros within # macros "this(that(tother)))", otherwise lose track of ()'s if($char eq '(') { $pairs++; } } } # deal with ',', add arg to list and start search for next one elsif($#Endchar == $s && $char eq ',') { # if char before this was a backslash, ignore this char if($backslash) { chop($arg); # delete backslash from string } else { push(@Args, CleanStart($arg)); $char = ''; $arg = ""; next; } } # deal \\ with an escaping \ ie. \" or \, or \\ if($char eq '\\') { if($backslash) { # found \\ $backslash = 0; # second backslash ignored chop($arg); # delete backslash from string } else{$backslash = 1;} } elsif($backslash) { $backslash = 0; } # check for end of args string if($#Endchar < $s) { push(@Args, CleanStart($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}); # check to see if macro can have any number of arguments (last arg ...) my $anyargs = ($#Argnames >= 0 && $Argnames[$#Argnames] =~ /\.\.\.\Z/o); # get arguments passed to this macro my @Argvals = ParseArgs($substring); # everything following macro args should be returned as tail my $tail = pop(@Argvals); # check the right number of args have been passed, should be all args # present plus string at end of args (assuming macro cannot have any number # of arguments) if(!$anyargs && $#Argvals != $#Argnames) { # show warning if wrong args (unless macro should have zero args and # 1 arg provided which is blank space if(!($#Argnames == -1 && $#Argvals == 0 && $Argvals[0] =~ /\A\s*\Z/)) { Warning("Macro \'".$macro."\' used with ".$#Argvals. " args, expected ".($#Argnames+1)); } # delete all excess args while($#Argvals > $#Argnames) { pop(@Argvals); } } # make all missing args blanks while($#Argvals < $#Argnames) { push(@Argvals, ""); } return (@Argvals, $tail); } ############################################################################## # FunctionMacro: used with functions to inform a module which macro # was being replaced when the function was called - used in bigfunc.pm ############################################################################## my $functionmacro = ""; sub FunctionMacro { return $functionmacro; } ############################################################################## # Replace all defined macro's arguments with their values # Inputs: # $macro = the macro to be replaces # $string = the string following the occurrence of macro ############################################################################## sub ReplaceDefineArgs { my ($string, $tail, %Used) = @_; # check if args used, if not do nothing if(DefineArgsUsed($tail)) { my $macro = $string; # get arguments following macro my @Argvals = FindDefineArgs($tail, $macro); $tail = pop(@Argvals); # tail returned as last element my @Argnames = split(/\,/, $DefinesArgs{$macro}); my ($i, $j); # replace previous macro with defn + args $string = $Defines{$macro}; # check if macro should call a function if(exists($DefinesFuncs{$macro})) { # replace all macros in argument list for($i=0; $i<=$#Argvals; $i++) { $Argvals[$i] = ReplaceDefines($Argvals[$i]); } if($debug > 1) { my $argstring = ""; if($#Argvals >= 0) { $argstring = join(", ", @Argvals); } Debug("Running function $DefinesFuncs{$macro} with args (". $argstring.")", 2); } # set name of macro which is being parse (needed in bigfunc.pm) $functionmacro = $macro; $string = $DefinesFuncs{$macro}->(@Argvals); # don't need do anything else, return now return $string, $tail; } # check if last arg ends in ... (allows any number of args in macro) if($#Argnames >= 0 && $Argnames[$#Argnames] =~ s/\.\.\.\Z//o) { # concatanate all extra args into final arg while($#Argvals > $#Argnames) { my $arg1 = pop(@Argvals); my $arg2 = pop(@Argvals); push(@Argvals, $arg2.", ".$arg1); } # check for ## at start of macro name in args list if($string =~ /\#\#$Argnames[$#Argnames]/) { # if last argument is empty remove preciding "," if($#Argvals == $#Argnames && $Argvals[$#Argnames] eq "") { $string =~ s/\,\s*\#\#$Argnames[$#Argnames]//g; } else { $string =~ s/\#\#$Argnames[$#Argnames]/$Argnames[$#Argnames]/g; } } } # to get args passed to macro to same processed level as rest of # macro, they need to be checked for occurrences of all used macros, # this is a nasty hack to temporarily change defines list to %Used { my %RealDefines = %Defines; my $realdefmin = $defmin; my $realdefmax = $defmax; my %RealDefineLookup = %DefineLookup; %Defines = %Used; GenerateDefinesKeys(); for($i=0; $i<=$#Argvals; $i++) { $Argvals[$i] = ReplaceDefines($Argvals[$i]); } # return defines to normal %Defines = %RealDefines; $defmin = $realdefmin; $defmax = $realdefmax; %DefineLookup = %RealDefineLookup; } # The next step replaces argnames with argvals. Once a bit of string # has been replaced it is removed from further processing to avoid # unwanted recursive macro replacement. my @InString = ( $string ); # string to be replaced my @InDone = ( 0 ); # flag to say if string section replaced my @OutString; # output of string sections after each # macro has been replaced my @OutDone; # output flags my $k = 0; for($i=0; $i<=$#Argnames; $i++) { for($j=0; $j<=$#InString; $j++) { if($InDone[$j] == 0) { # replace macros and split up string so replaced part # is flagged as done and rest is left for further # processing while($InString[$j] =~ /$bound$Argnames[$i]$bound/) { $OutString[$k] = $`; $OutDone[$k] = 0; $k++; $OutString[$k] = $Argvals[$i]; $OutDone[$k] = 1; $k++; $InString[$j] = $'; # one more quote for emacs ' } } $OutString[$k] = $InString[$j]; $OutDone[$k] = $InDone[$j]; $k++; } @InString = @OutString; @InDone = @OutDone; $k = 0; } # rebuild string $string = join('', @InString); Debug("Replaced \"".$macro."\" for \"".$string."\" [".$recurse_level."]", 2); } else { Debug("Macro \"".$string."\" found without args, ignored", 2); } return ($string, $tail); } ############################################################################## # When replacing macros with args, the macro and everything following the # macro (the tail) are passed to ReplaceDefineArgs. The function extracts # the args from the tail and then returns the replaced macro and the new # tail. This function extracts the remaining part of the real tail from # the current input string. ############################################################################## sub ReclaimTail { my ($input, $tail) = @_; # split strings into chars and compare each one until difference found my @Input = split(//, $input); my @Tail = split(//, $tail); $tail = $input = ""; while($#Input >= 0 && $#Tail >= 0 && $Input[$#Input] eq $Tail[$#Tail]) { $tail = pop(@Tail).$tail; pop(@Input); } while($#Input >=0) { $input = pop(@Input).$input; } return ($input, $tail); } ############################################################################## # Replace all defined macro's in a line with their value. Recursively run # through macros as many times as needed (to find macros within macros). # Inputs: # $input = string to process # $tail = rest of line following $string (if any), this will only be used # if string contains a macro with args, the args will probably be # at the start of the tail # %Used = all macros found in $string so far, these will not be checked # again to avoid possible recursion # Initially just $input is passed in, other args are added for recursive calls ############################################################################## sub ReplaceDefines { my ($input, $tail, %Used) = @_; # check for recursive macro madness (set to same level as Perl warning) if(++$recurse_level > 97) { $recurse_level--; Warning("Recursive macro detected in \"".$input."\""); if($tail) { return ($input, $tail); } return $input; } my $out = ""; # initialise output to empty string OUTER : while($input =~ /\S/o) { my ($macro, $string); my @Words; ###################################################################### # if macros start with prefix, skip to next prefix ###################################################################### if($macroprefix ne "") { my $found = 0; # find next potential macro in line if any while(!$found && $input =~ /$macroprefix\S/) { # everything before prefix $out = $out.$`; # reclaim first char in macro my $match = $&; # everything after prefix $input = chop($match).$'; # one more quote for emacs ' # check if first chars are in macro if(exists($DefineLookup{substr($input, 0, $defmin)})) { $found = 1; } # put prefix back onto output and carry on searching else { $out = $out.$match; } } # no more macros if(!$found) { $out = $out.$input; $input = ""; last OUTER; } } ###################################################################### # replacing macros which are "words" only - quick and easy ###################################################################### if($bound eq '\b') { @Words = split(/(\w+)/, $input, 2); $out = $out.$Words[0]; if($#Words == 2) { $macro = $Words[1]; $input = $Words[2]; } else { $input = ""; last OUTER; } } ###################################################################### # replacing all types of macro - slow and horrid ###################################################################### else { # forward string to next non-whitespace char that starts a macro while(!exists($DefineLookup{substr($input, 0, $defmin)})) { if($input =~ /^\s/ ) { # remove preceding whitespace @Words = split(/^(\s+)/, $input, 2); $out = $out.$Words[1]; $input = $Words[2]; } else { # skip to next char $out = $out.substr($input, 0, 1); $input = substr($input, 1); } if($input eq "") { last OUTER; } } # remove the longest possible potential macro (containing no # whitespace) from the start of input @Words = split(/(\s+)/, $input, 2); $macro = $Words[0]; if($#Words == 2) {$input = $Words[1].$Words[2]; } else {$input = ""; } # shorten macro if too long if(length($macro) > $defmax) { $input = substr($macro, $defmax).$input; $macro = substr($macro, 0, $defmax); } # see if a macro exists in "macro" while(length($macro) > $defmin && !(exists($Defines{$macro}) && !exists($Used{$macro}))) { # chop a char off macro and try again $input = chop($macro).$input; } } # check if macro is at start of string and has not been used yet if(exists($Defines{$macro}) && !exists($Used{$macro})) { # set macro as used $Used{$macro} = $Defines{$macro}; # temporarily add tail to input if($tail) { $input = $input.$tail; } # replace macro with defn if(CheckDefineArgs($macro)) { ($string, $input) = ReplaceDefineArgs($macro, $input, %Used); } else { $string = $Defines{$macro}; Debug("Replaced \"".$macro."\" for \"".$string."\" [".$recurse_level."]", 2); } ($string=~ m/\#\#/) and ($string=~ s/\s*\#\#\s*//gm); @Words = ReplaceDefines($string, $input, %Used); $out = $out.$Words[0]; if($#Words == 0) { $input = ""; } else { # remove space up to start of next char if(CheckEatTrail($macro)) { $Words[1] =~ s/^[ \t]*//o; } $input = $Words[1]; } delete($Used{$macro}); # reclaim all unparsed tail if($tail && $tail ne "") { ($input, $tail) = ReclaimTail($input, $tail); } } # macro not matched, add to output and move swiftly on else { if($bound eq '\b') { $out = $out.$macro; } else { $out = $out.substr($macro, 0, 1); $input = substr($macro, 1).$input; } } } $recurse_level--; # append any whitespace left in string and return it if($tail) { return ($out.$input, $tail); } return $out.$input; } ############################################################################## # GenerateDefinesKey creates all keys and indices needed for %Defines ############################################################################## sub GenerateDefinesKeys { # find longest and shortest macro my ($define, $length) = each %Defines; $defmin = $defmax = length($define); %DefineLookup = (); foreach $define (keys(%Defines)) { $length = length($define); if($length > $defmax) { $defmax = $length; } if($length < $defmin) { $defmin = $length; } } # regenerate lookup table of first letters foreach $define (keys(%Defines)) { $DefineLookup{substr($define, 0, $defmin)} = 1; } } ############################################################################## # Set a define ############################################################################## sub SetDefine { my ($macro, $value) = @_; # add macro and value to hash table $Defines{$macro} = $value; # add define to keys my $length = length($macro); if($length < $defmin || $defmin == 0) { GenerateDefinesKeys(); } else { if($length > $defmax) { $defmax = $length; } $length = substr($macro, 0, $defmin); $DefineLookup{$length} = 1; } } ############################################################################## # Get a define without doing any macro replacement ############################################################################## sub GetDefine { my $macro = shift; return $Defines{$macro}; } ############################################################################## # 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; } ############################################################################## # Set a function which should be called when a macro is found ############################################################################## sub SetDefineFuncs { my $macro = shift; my $func = shift; # add macro function to hash table $DefinesFuncs{$macro} = $func; } ############################################################################## # 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}); } ############################################################################## # Check if a macro is defined and calls a function ############################################################################## sub CheckDefineFuncs { my $macro = shift; return exists($DefinesFuncs{$macro}); } ############################################################################## # Check if a macro is defined and eats trailing whitespace ############################################################################## sub CheckEatTrail { my $macro = shift; return exists($EatTrail{$macro}); } ############################################################################## # Set eat-trailing-whitespace for a macro ############################################################################## sub SetEatTrail { my $macro = shift; $EatTrail{$macro} = 1; } ############################################################################## # 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!", 2); return 0; } Debug("Checking for file: ".$filename."...found!", 2); return 1; } ############################################################################## # #comment - rest of line ignored as a comment ############################################################################## sub Comment { # nothing to be done here Debug("Commented line", 2); } ############################################################################## # 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; # check there is an argument if($macrodefn !~ /\S/o) { Filepp::Error("define keyword used without arguments"); } # find end of macroword - assume separated by space or tab $i = GetNextWordEnd($macrodefn); # separate macro and defn (can't use split, doesn't work with '0') $macro = substr($macrodefn, 0, $i); $defn = substr($macrodefn, $i); # strip leading whitespace from $defn if($defn) { $defn =~ s/^[ \t]*//; } else { $defn = ""; } # check if macro has arguments (will be a '(' in macro) if($macro =~ /\(/) { # split up macro, args and defn - delimiters = 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.")", 2); # put rest of defn back together $defn = join('',@arglist); $defn = CleanStart($defn); } # make sure macro is not being redefined and used to have args else { delete($DefinesArgs{$macro}); delete($DefinesFuncs{$macro}); } # define the macro defn pair SetDefine($macro, $defn); Debug("Defined \"".$macro."\" to be \"".$defn."\"", 2); if($debug > 2) { PrintDefines(); } } ############################################################################## # Else, standard if[n][def]-else-endif # usage: #else somewhere between #if[n][def] key and #endif ############################################################################## sub Else { # else always true - only ran when all preceding 'if's have failed return 1; } ############################################################################## # Endif, standard ifdef-[else]-endif # usage: #endif somewhere after #ifdef key and optionally #else ############################################################################## sub Endif { # this always terminates an if block return 1; } ############################################################################## # If conditionally includes or ignores parts of a file based on expr # usage: #if expr # expr is evaluated 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; Debug("If: parsing: \"".$expr."\"", 2); # check for any "defined MACRO" tests and evaluate them if($expr =~ /defined/) { my $indefined = 0; # split expr up into its component parts, the split is done on the # following list of chars and strings: '!','(',')','&&','||', space 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 (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...", 2); if(CheckDefine($expr)) { $expr = 1; Debug("If: defined", 2); } else { $expr = 0; Debug("If: NOT defined", 2); } $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 = join('',@Exprs); $expr = $newexpr; } # pass parsed line though processors $expr = RunProcessors($expr); # evaluate line and return result (1 = true) Debug("If: evaluating \"".$expr."\"", 2); my $result = eval($expr); # check if statement is valid if(!defined($result)) { Warning($@); } elsif($result) { Debug("If: \"".$expr."\" true", 1); return 1; } Debug("If: \"".$expr."\" false", 1); return 0; } ############################################################################## # Elif equivalent to "else if". Placed between #if[n][def] and #endif, # equivalent to nesting #if's ############################################################################## sub Elif { my $input = shift; return 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)) { Debug("Ifdef: ".$macro." defined", 1); return 1; } Debug("Ifdef: ".$macro." not defined", 1); return 0; } ############################################################################## # 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)) { Debug("Ifndef: ".$macro." defined", 1); return 0; } Debug("Ifndef: ".$macro." not defined", 1); return 1; } ############################################################################## # Parses all macros from file, but discards all other output ############################################################################## sub IncludeMacros { my $file = shift; my $currentoutput = $output; SetOutput(0); Parse($file); SetOutput($currentoutput); } ############################################################################## # 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 - system include file, use -Ipath ############################################################################## sub Include { my $input = shift; my $filename = $input; my $fullname; my $sysinclude = 0; my $found = 0; my $i; # check for recursive includes (level set to same as Perl recurse warn) if($include_level >= 98) { Warning("Include recursion too deep - skipping \"".$filename."\"\n"); return; } # replace any defined values in the include line $filename = RunProcessors($filename); # check if it is a system include file (#include ) or a local # include file (#include "filename") if(substr($filename, 0, 1) eq "<") { $sysinclude = 1; # remove <> from filename $filename = substr($filename, 1); ($filename) = split(/\>/, $filename, 2); } elsif(substr($filename, 0, 1) eq "\"") { # remove double quotes from filename $filename = substr($filename, 1); ($filename) = split(/\"/, $filename, 2); } # else assume filename given without "" or <>, naughty but allowed # check for file in current directory if($sysinclude == 0) { # get name of directory base file is in my $dir = ""; if($file =~ /\//) { my @Dirs = split(/(\/)/, $file); for($i=0; $i<$#Dirs; $i++) { $dir = $dir.$Dirs[$i]; } } if(FileExists($dir.$filename)) { $fullname = $dir.$filename; $found = 1; } } # search for file in include paths, first path on command line first $i = 0; while($found == 0 && $i <= $#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."\"", 1); # recursively call Parse Parse($fullname); } else { Warning("Include file \"".$filename."\" not found", 1); } } ############################################################################## # 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\b/) { 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.")", 1); } else { my @Args = ParseArgs($args); Debug("Running function: ".$function."(".$args.")", 1); $function->(@Args); } } } } ############################################################################## # Turn normal output on/off (does not affect any output produced by keywords) # 1 = on, 0 = off ############################################################################## sub SetOutput { $output = shift; Debug("Output set to ".$output, 2); } ############################################################################## # Turn blank suppression on and off at this include level # 1 = on, 0 = off ############################################################################## sub SetBlankSupp { $blanksupp[$include_level] = shift; Debug("Blank suppression set to ".$blanksupp[$include_level], 2); } ############################################################################## # Reset blank suppression to command-line value (except at level 0) ############################################################################## sub ResetBlankSupp { if($include_level == 0) { $blanksupp[$include_level] = 0; } else { $blanksupp[$include_level] = $blanksuppopt; } Debug("Blank suppression reset to ".$blanksupp[$include_level], 2); } ############################################################################## # Set if macros are only replaced if the macro is a 'word' ############################################################################## sub SetWordBoundaries { my $on = shift; if($on) { $bound = '\b'; Debug("Word Boundaries turned on", 2); } else { $bound = ''; Debug("Word Boundaries turned off", 2); } } ############################################################################## # DEPRECATED - this function will be removed in later versions, use Set # Toggle if macros are only replaced if the macro is a 'word' ############################################################################## sub ToggleWordBoundaries { if($bound eq '\b') { SetWordBoundaries(1); } else { SetWordBoundaries(0); } } ############################################################################## # Set treating keywordchar, contchar, macroprefix and optlineendchar as # Perl regexps ############################################################################## sub SetCharPerlre { $charperlre = shift; Debug("Characters treated as Perl regexp's : ".$charperlre, 2); } ############################################################################## # 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}; delete $DefinesArgs{$macro}; delete $DefinesFuncs{$macro}; # and remove its eat-trailing-whitespace flag if(CheckEatTrail($macro)) { delete $EatTrail{$macro}; } # regenerate keys GenerateDefinesKeys(); Debug("Undefined macro \"".$macro."\"", 2); if($debug > 1) { PrintDefines(); } } ############################################################################## # UndefAll - undefines ALL macros ############################################################################## sub UndefAll { %Defines = (); %DefineLookup = (); %EatTrail = (); $defmin = $defmax = 0; Debug("Undefined ALL macros", 2); if($debug > 1) { PrintDefines(); } } ############################################################################## # #warning msg - print warning message "msg" ############################################################################## sub Warning { my $msg = shift; my $lastdebug = $debug; $debug = 1; Debug($msg, 1); $debug = $lastdebug; } ############################################################################## # ParseLineEnd - takes in line from input most recently read and checks # if line should be continued (ie. next line in input read and appended # to current line). # Returns two values: # $more - boolean, 1 = read another line from input to append to this one # 0 = no line continuation # $line - the line to be read. If any modification needs to be done to the # line for line contination, it is done here. # Example: if line is to be continued: set $more = 1, then # remove line continuation character and newline from end of # $line and replace with line continuation character. ############################################################################## sub ParseLineEnd { my $thisline = shift; my $more = 0; # check if end of line has a continuation char, if it has get next line if($thisline =~ /$contchar$/) { $more = 1; # remove backslash and newline $thisline =~ s/$contchar\n\Z//; # append line continuation character $thisline = $thisline.$contrepchar; } return ($more, $thisline); } ############################################################################## # Set name of function to take check if line shoule be continued ############################################################################## sub SetParseLineEnd { my $func = shift; $parselineend = $func; } ############################################################################## # Get name of function to take check if line shoule be continued ############################################################################## sub GetParseLineEnd { return $parselineend; } ############################################################################## # GetNextLine - returns the next line of the current INPUT line, # line continuation is taken care of here. ############################################################################## sub GetNextLine { my $thisline = ; if($thisline) { Redefine("__LINE__", ++$line); my $more = 0; ($more, $thisline) = $parselineend->($thisline); while($more) { Debug("Line continuation", 2); my $nextline = ; if(!$nextline) { return $thisline; } # increment line count Redefine("__LINE__", ++$line); ($more, $thisline) = $parselineend->($thisline.$nextline); # maintain same number of lines in input as output if($preserveblank) { Filepp::Output("\n"); } } } return $thisline; } ############################################################################## # Write($string) - writes $string to OUTPUT file ############################################################################## sub Write { my $string = shift; print(OUTPUT $string); } ############################################################################## # Output($string) - conditionally writes $string to OUTPUT file ############################################################################## sub Output { my $string = shift; if($output) { Write($string); } } # counter for number of #if[n][def] loops currently in my $iflevel = 0; # flag to control when to write output my @Writing = (1); # initialise default to 'writing' # flag to show if current 'if' block has passed a 'true if' my @Ifdone = (0); # initialise first to 'not passed true if' ############################################################################## # Keyword parsing routine ############################################################################## sub ParseKeywords { # input is next line in file my $inline = shift; my $outline = ""; my $thisline = $inline; my $keyword; my $found = 0; # 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\s*//g; # remove the optional end line char if($optlineendchar ne "") { $thisline =~ s/$optlineendchar\Z//g; } # check for keyword if($thisline && $thisline =~ /^\w+\b/ && exists($Keywords{$&})) { $keyword = $&; $found = 1; # remove newline from line chomp($thisline); # remove leading whitespace and keyword from line my $inline = CleanStart(substr($thisline, length($keyword))); # check for 'if' style keyword if(exists($Ifwords{$keyword})) { # increment ifblock level and set ifdone to same # value as previous block $iflevel++; $Ifdone[$iflevel] = 0; $Writing[$iflevel] = $Writing[$iflevel - 1]; if(!$Writing[$iflevel]) { $Ifdone[$iflevel] = 1; } } # check for out of place 'else' or 'endif' style keyword elsif($iflevel <= 0 && (exists($Elsewords{$keyword}) || exists($Endifwords{$keyword}) )) { Warning($keywordchar.$keyword." found without preceding ". $keywordchar."[else]ifword"); } # decide if to run 'if' or 'else' keyword if(exists($Ifwords{$keyword}) || exists($Elsewords{$keyword})){ if(!($Ifdone[$iflevel])) { # check return value of 'if' if($Keywords{$keyword}->($inline)) { $Ifdone[$iflevel] = 1; $Writing[$iflevel] = 1; } else { $Writing[$iflevel] = 0; } } else { $Writing[$iflevel] = 0; } } # check for 'endif' style keyword elsif(exists($Endifwords{$keyword})) { # run endif keyword and decrement iflevel if true if($Keywords{$keyword}->($inline)) { $iflevel--; } } # run all other keywords elsif($Writing[$iflevel]) { $Keywords{$keyword}->($inline); } # write a blank line if preserving blank lines # (assumes keywords have no output) if($preserveblank) { $outline = $outline."\n"; } } # keyword if statement } # no keywords in line - write line to file if not #ifdef'ed out if(!$found && $Writing[$iflevel]) { $outline = $outline.$inline; } # keep same number of files in output and input elsif(!$found && $preserveblank) { $outline = $outline."\n"; } return $outline; } ############################################################################## # 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."...", 1); Redefine("__FILE__", $file); # reset line count, remembering previous count for future reference my $lastcount = $line; $line = 0; Redefine("__LINE__", $line); # increment include level Redefine("__INCLUDE_LEVEL__", ++$include_level); # set blank line suppression: # no suppression for top level files if($include_level == 0) { $blanksupp[$include_level] = 0; } # include level 1 - set suppression to command line given value elsif($include_level == 1) { # inherit root value if set if($blanksupp[0]) { $blanksupp[$include_level] = 1; } else {$blanksupp[$include_level] = $blanksuppopt; } } # all other include levels - keep suppression at existing value else { $blanksupp[$include_level] = $blanksupp[$include_level - 1]; } # reset RunProcessors function for this file $Running[$include_level] = 0; $Currentproc[$include_level] = 0; # open file and set its handle to INPUT local *INPUT; if(!open(INPUT, $file)) { Error("Could not open file ".$file); } # if a base file, run any initialisation functions if($include_level == 0) { my $func; foreach $func (@OpenInputFuncs) { $func->(); } } # parse each line of file $_ = GetNextLine(); # if in "shebang" mode, throw away first line (the #!/blah bit) if($shebang) { # check for "#!...perl ...filepp..." if($_ && $_ =~ /^\#\!.*perl.+filepp/) { Debug("Skipping first line (shebang): ".$_, 1); $_ = GetNextLine(); } } while($_) { # unless blank lines are suppressed at this include level unless($blanksupp[$include_level] && /^\s*$/) { # run processing chain (defaults to ReplaceDefines) $_ = RunProcessors($_, 1); # write output to file or STDOUT if($output) { Write($_); } } $_ = GetNextLine(); } # run any close functions if($include_level == 0) { my $func; foreach $func (@CloseInputFuncs) { $func->(); } } # check all #if blocks have been closed at end of parsing if($lastparse eq "" && $iflevel > 0) { Warning("Unterminated if block"); } # close file close(INPUT); Debug("Parsing ".$file." done. (".$line." lines processed)", 1); # 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, 1); } # 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]) { # suppress blank lines in header files if($ARGV[$i] eq "-b") { $blanksuppopt = 1; } # read from stdin instead of file elsif($ARGV[$i] eq "-c") { AddInputFile("-"); } # 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); } # add macro and defn to hash table Define($macro." ".$defn); } # Debugging turned on: -d elsif($ARGV[$i] eq "-d") { SetDebug(2); } # Full debugging turned on: -dd elsif($ARGV[$i] eq "-dd") { SetDebug(3); } # Light debugging turned on: -dl elsif($ARGV[$i] eq "-dl") { SetDebug(1); } # Send debugging info to stdout rather than stderr elsif($ARGV[$i] eq "-ds") { $debugstdout = 1; } # prefix all debugging info with string elsif($ARGV[$i] eq "-dpre") { if($i+1 >= $argc) { Error("Argument to `-dpre' is missing"); } $debugprefix = ReplaceDefines($ARGV[++$i]); } # prefix all debugging info with string elsif($ARGV[$i] eq "-dpost") { if($i+1 >= $argc) { Error("Argument to `-dpost' is missing"); } # replace defines is called here in case a newline is required, # this allows it to be added as __NEWLINE__ $debugpostfix = ReplaceDefines($ARGV[++$i]); } # define environment variables as macros: -e elsif($ARGV[$i] eq "-e") { DefineEnv(); } # set environment variable prefix char elsif($ARGV[$i] eq "-ec") { if($i+1 >= $argc) { Error("Argument to `-ec' is missing"); } SetEnvchar($ARGV[++$i]); } # set environment variable prefix char to nothing elsif($ARGV[$i] eq "-ecn") { SetEnvchar(""); } # 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"); } AddIncludePath($ARGV[++$i]); } # -Iinclude format else { AddIncludePath(substr($ARGV[$i], 2)); } } # Include macros from file: -imacros file elsif($ARGV[$i] eq "-imacros") { if($i+1 >= $argc) { Error("Argument to `-imacros' is missing"); } push(@Imacrofiles, $ARGV[++$i]); } # 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 optional line end character elsif($ARGV[$i] eq "-lec") { if($i+1 >= $argc) { Error("Argument to `-lec' is missing"); } SetOptLineEndchar($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]); } # Module paths: -Minclude or -M include elsif(substr($ARGV[$i], 0, 2) eq "-M") { # -M include format if(length($ARGV[$i]) == 2) { if($i+1 >= $argc) { Error("Argument to `-M' is missing"); } AddModulePath($ARGV[++$i]); } # -Minclude format else { AddModulePath(substr($ARGV[$i], 2)); } } # use module elsif($ARGV[$i] eq "-m") { if($i+1 >= $argc) { Error("Argument to `-m' is missing"); } UseModule($ARGV[++$i]); } # set macro prefix elsif($ARGV[$i] eq "-mp") { if($i+1 >= $argc) { Error("Argument to `-mp' is missing"); } SetMacroPrefix($ARGV[++$i]); } # turn off macro prefix within keywords elsif($ARGV[$i] eq "-mpnk") { $macroprefixinkeywords = 0; } # turn on overwrite mode elsif($ARGV[$i] eq "-ov") { $overwrite = 1; } # turn on overwrite conversion mode elsif($ARGV[$i] eq "-ovc") { if($i+1 >= $argc) { Error("Argument to `-ovc' is missing"); } $overwriteconv = $ARGV[++$i]; if($overwriteconv !~ /=/) { Error("-ovc argument is of form IN=OUT"); } $overwrite = 1; } # 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 `-o' is missing"); } $outputfile = $ARGV[++$i]; } # -ofilename else { $outputfile = substr($ARGV[$i], 2); } } # preserve blank lines in output file elsif($ARGV[$i] eq "-pb") { $preserveblank = 1; } # treat $keywordchar, $contchar and $optlineendchar as regular expressions elsif($ARGV[$i] eq "-re") { if($charperlre) { SetCharPerlre(0); } else { SetCharPerlre(1); } } # 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); } # only replace macros if they appear as 'words' elsif($ARGV[$i] eq "-w") { if($bound eq '') { SetWordBoundaries(1); } else { SetWordBoundaries(0); } } # default - an input file name else { if(!FileExists($ARGV[$i])) { Error("Input file \"".$ARGV[$i]."\" not readable"); } AddInputFile($ARGV[$i]); } $i++; } # check input files have been specified if($#Inputfiles == -1) { Error("No input files given"); } # import macros from file if any if($#Imacrofiles >= 0) { my $file; foreach $file (@Imacrofiles) { IncludeMacros($file); } } # print initial defines if debugging if($debug > 1) { PrintDefines(); } # open the output file if(!$overwrite) { OpenOutputFile($outputfile); } # parse all input files in order given on command line my $base_file = ""; foreach $base_file (@Inputfiles) { Redefine("__BASE_FILE__", $base_file); # set open output file if in overwrite mode if($overwrite) { if($overwriteconv ne "") { # convert output filename if needed my ($in,$out) = split(/=/, $overwriteconv, 2); my $outfile = $base_file; $outfile =~ s/\Q$in\E/$out/; OpenOutputFile($outfile); } else { OpenOutputFile($base_file); } } Parse($base_file); # close output file if in overwrite mode if($overwrite) { CloseOutputFile(); } } # close output file if(!$overwrite) { CloseOutputFile(); } exit(0); # Hey emacs !! # Local Variables: # mode: perl # End: ######################################################################## # End of file ########################################################################