| #!/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<length($string); $char++) { |
| push(@Chars, substr($string, $char, 1)); |
| } |
| my @Args; # list of Args |
| my $arg = ""; |
| my @Endchar; |
| # special characters - no processing is done between character pairs |
| my %SpecialChars = ('(' => ')', '"' => '"', '\'' => '\''); |
| 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 <filename> - 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 <filename>) 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 = <INPUT>; |
| if($thisline) { |
| Redefine("__LINE__", ++$line); |
| my $more = 0; |
| ($more, $thisline) = $parselineend->($thisline); |
| while($more) { |
| Debug("Line continuation", 2); |
| my $nextline = <INPUT>; |
| 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 |
| ######################################################################## |
