加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
克隆/下载
filepp 82.39 KB
一键复制 编辑 原始数据 按行查看 历史
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733
#!/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
########################################################################
Loading...
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化