forked from llvm/llvm-test-suite
-
Notifications
You must be signed in to change notification settings - Fork 0
/
filepp
executable file
·2733 lines (2391 loc) · 82.4 KB
/
filepp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/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});
}
}