TeaSpeak
/
tommath
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sanitize some Perl scripts 

(Perl4 is gone)
This commit is contained in:
Francois Perrad 2015-12-10 07:30:09 +01:00 committed by Steffen Jaeckel
parent 2bc7bdbb3f
commit 38fe9eec7c
5 changed files with 92 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
dep.pl
View File

@ -2,122 +2,126 @@
# #
# Walk through source, add labels and make classes # Walk through source, add labels and make classes
# #
#use strict; use strict;
use warnings;
my %deplist; my %deplist;
#open class file and write preamble #open class file and write preamble
open(CLASS, ">tommath_class.h") or die "Couldn't open tommath_class.h for writing\n"; open(my $class, '>', 'tommath_class.h') or die "Couldn't open tommath_class.h for writing\n";
print CLASS "#if !(defined(LTM1) && defined(LTM2) && defined(LTM3))\n#if defined(LTM2)\n#define LTM3\n#endif\n#if defined(LTM1)\n#define LTM2\n#endif\n#define LTM1\n\n#if defined(LTM_ALL)\n"; print {$class} "#if !(defined(LTM1) && defined(LTM2) && defined(LTM3))\n#if defined(LTM2)\n#define LTM3\n#endif\n#if defined(LTM1)\n#define LTM2\n#endif\n#define LTM1\n\n#if defined(LTM_ALL)\n";
foreach my $filename (glob "bn*.c") { foreach my $filename (glob 'bn*.c') {
my $define = $filename; my $define = $filename;
print "Processing $filename\n"; print "Processing $filename\n";
# convert filename to upper case so we can use it as a define # convert filename to upper case so we can use it as a define
$define =~ tr/[a-z]/[A-Z]/; $define =~ tr/[a-z]/[A-Z]/;
$define =~ tr/\./_/; $define =~ tr/\./_/;
print CLASS "#define $define\n"; print {$class} "#define $define\n";
# now copy text and apply #ifdef as required # now copy text and apply #ifdef as required
my $apply = 0; my $apply = 0;
open(SRC, "<$filename"); open(my $src, '<', $filename);
open(OUT, ">tmp"); open(my $out, '>', 'tmp');
# first line will be the #ifdef # first line will be the #ifdef
my $line = <SRC>; my $line = <$src>;
if ($line =~ /include/) { if ($line =~ /include/) {
print OUT $line; print {$out} $line;
} else { } else {
print OUT "#include <tommath.h>\n#ifdef $define\n$line"; print {$out} "#include <tommath.h>\n#ifdef $define\n$line";
$apply = 1; $apply = 1;
} }
while (<SRC>) { while (<$src>) {
if (!($_ =~ /tommath\.h/)) { if (!($_ =~ /tommath\.h/)) {
print OUT $_; print {$out} $_;
} }
} }
if ($apply == 1) { if ($apply == 1) {
print OUT "#endif\n"; print {$out} "#endif\n";
} }
close SRC; close $src;
close OUT; close $out;
unlink($filename); unlink $filename;
rename("tmp", $filename); rename 'tmp', $filename;
} }
print CLASS "#endif\n\n"; print {$class} "#endif\n\n";
# now do classes # now do classes
foreach my $filename (glob "bn*.c") { foreach my $filename (glob 'bn*.c') {
open(SRC, "<$filename") or die "Can't open source file!\n"; open(my $src, '<', $filename) or die "Can't open source file!\n";
# convert filename to upper case so we can use it as a define # convert filename to upper case so we can use it as a define
$filename =~ tr/[a-z]/[A-Z]/; $filename =~ tr/[a-z]/[A-Z]/;
$filename =~ tr/\./_/; $filename =~ tr/\./_/;
print CLASS "#if defined($filename)\n"; print {$class} "#if defined($filename)\n";
my $list = $filename; my $list = $filename;
# scan for mp_* and make classes # scan for mp_* and make classes
while (<SRC>) { while (<$src>) {
my $line = $_; my $line = $_;
while ($line =~ m/(fast_)*(s_)*mp\_[a-z_0-9]*/) { while ($line =~ m/(fast_)*(s_)*mp\_[a-z_0-9]*/) {
$line = $'; $line = $';
# now $& is the match, we want to skip over LTM keywords like # now $& is the match, we want to skip over LTM keywords like
# mp_int, mp_word, mp_digit # mp_int, mp_word, mp_digit
if (!($& eq "mp_digit") && !($& eq "mp_word") && !($& eq "mp_int") && !($& eq "mp_min_u32")) { if (!($& eq 'mp_digit') && !($& eq 'mp_word') && !($& eq 'mp_int') && !($& eq 'mp_min_u32')) {
my $a = $&; my $a = $&;
$a =~ tr/[a-z]/[A-Z]/; $a =~ tr/[a-z]/[A-Z]/;
$a = "BN_" . $a . "_C"; $a = 'BN_' . $a . '_C';
if (!($list =~ /$a/)) { if (!($list =~ /$a/)) {
print CLASS " #define $a\n"; print {$class} " #define $a\n";
} }
$list = $list . "," . $a; $list = $list . ',' . $a;
} }
} }
} }
@deplist{$filename} = $list; $deplist{$filename} = $list;
print CLASS "#endif\n\n"; print {$class} "#endif\n\n";
close SRC; close $src;
} }
print CLASS "#ifdef LTM3\n#define LTM_LAST\n#endif\n#include <tommath_superclass.h>\n#include <tommath_class.h>\n#else\n#define LTM_LAST\n#endif\n"; print {$class} "#ifdef LTM3\n#define LTM_LAST\n#endif\n#include <tommath_superclass.h>\n#include <tommath_class.h>\n#else\n#define LTM_LAST\n#endif\n";
close CLASS; close $class;
#now let's make a cool call graph... #now let's make a cool call graph...
open(OUT,">callgraph.txt"); open(my $out, '>', 'callgraph.txt');
$indent = 0; my $indent = 0;
foreach (keys %deplist) { my $list;
$list = ""; foreach (sort keys %deplist) {
draw_func(@deplist{$_}); $list = '';
print OUT "\n\n"; draw_func($deplist{$_});
print {$out} "\n\n";
} }
close(OUT); close $out;
sub draw_func() sub draw_func
{ {
my @funcs = split(",", $_[0]); my @funcs = split ',', $_[0];
if ($list =~ /@funcs[0]/) { if ($list =~ /$funcs[0]/) {
return; return;
} else { } else {
$list = $list . @funcs[0]; $list = $list . $funcs[0];
} }
if ($indent == 0) { } if ($indent == 0) {
elsif ($indent >= 1) { print OUT "| " x ($indent - 1) . "+--->"; } } elsif ($indent >= 1) {
print OUT @funcs[0] . "\n"; print {$out} '| ' x ($indent - 1) . '+--->';
}
print {$out} $funcs[0] . "\n";
shift @funcs; shift @funcs;
my $temp = $list; my $temp = $list;
foreach my $i (@funcs) { foreach my $i (@funcs) {
++$indent; ++$indent;
draw_func(@deplist{$i}); draw_func($deplist{$i}) if exists $deplist{$i};
--$indent; --$indent;
} }
$list = $temp; $list = $temp;
return;
} }

30
filter.pl
View File

@ -2,32 +2,32 @@
# we want to filter every between START_INS and END_INS out and then insert crap from another file (this is fun) # we want to filter every between START_INS and END_INS out and then insert crap from another file (this is fun)
$dst = shift; use strict;
$ins = shift; use warnings;
open(SRC,"<$dst"); open(my $src, '<', shift);
open(INS,"<$ins"); open(my $ins, '<', shift);
open(TMP,">tmp.delme"); open(my $tmp, '>', 'tmp.delme');
$l = 0; my $l = 0;
while (<SRC>) { while (<$src>) {
if ($_ =~ /START_INS/) { if ($_ =~ /START_INS/) {
print TMP $_; print {$tmp} $_;
$l = 1; $l = 1;
while (<INS>) { while (<$ins>) {
print TMP $_; print {$tmp} $_;
} }
close INS; close $ins;
} elsif ($_ =~ /END_INS/) { } elsif ($_ =~ /END_INS/) {
print TMP $_; print {$tmp} $_;
$l = 0; $l = 0;
} elsif ($l == 0) { } elsif ($l == 0) {
print TMP $_; print {$tmp} $_;
} }
} }
close TMP; close $tmp;
close SRC; close $src;
# $Source$ # $Source$
# $Revision$ # $Revision$

19
gen.pl
View File

@ -4,16 +4,17 @@
# add the whole source without any makefile troubles # add the whole source without any makefile troubles
# #
use strict; use strict;
use warnings;
open( OUT, ">mpi.c" ) or die "Couldn't open mpi.c for writing: $!"; open(my $out, '>', 'mpi.c') or die "Couldn't open mpi.c for writing: $!";
foreach my $filename (glob "bn*.c") { foreach my $filename (glob 'bn*.c') {
open( SRC, "<$filename" ) or die "Couldn't open $filename for reading: $!"; open(my $src, '<', $filename) or die "Couldn't open $filename for reading: $!";
print OUT "/* Start: $filename */\n"; print {$out} "/* Start: $filename */\n";
print OUT while <SRC>; print {$out} $_ while <$src>;
print OUT "\n/* End: $filename */\n\n"; print {$out} "\n/* End: $filename */\n\n";
close SRC or die "Error closing $filename after reading: $!"; close $src or die "Error closing $filename after reading: $!";
} }
print OUT "\n/* EOF */\n"; print {$out} "\n/* EOF */\n";
close OUT or die "Error closing mpi.c after writing: $!"; close $out or die "Error closing mpi.c after writing: $!";
system('perl -pli -e "s/\s*$//" mpi.c'); system('perl -pli -e "s/\s*$//" mpi.c');

3
makefile
View File

@ -193,3 +193,6 @@ zipup:
new_file: new_file:
bash updatemakes.sh bash updatemakes.sh
perl dep.pl perl dep.pl
perlcritic:
perlcritic *.pl

15
parsenames.pl
View File

@ -4,18 +4,21 @@
# wrapped at 80 chars # wrapped at 80 chars
# #
# Tom St Denis # Tom St Denis
@a = split(" ", $ARGV[1]); use strict;
$b = "$ARGV[0]="; use warnings;
$len = length($b);
my @a = split ' ', $ARGV[1];
my $b = $ARGV[0] . '=';
my $len = length $b;
print $b; print $b;
foreach my $obj (@a) { foreach my $obj (@a) {
$len = $len + length($obj); $len = $len + length $obj;
$obj =~ s/\*/\$/; $obj =~ s/\*/\$/;
if ($len > 100) { if ($len > 100) {
printf "\\\n"; printf "\\\n";
$len = length($obj); $len = length $obj;
} }
print "$obj "; print $obj . ' ';
} }
print "\n\n"; print "\n\n";