sanitize some Perl scripts
(Perl4 is gone)
This commit is contained in:
Francois Perrad
Steffen Jaeckel
parent
2bc7bdbb3f
commit
38fe9eec7c
98
dep.pl
98
dep.pl
@ -2,15 +2,16 @@
|
||||
#
|
||||
# Walk through source, add labels and make classes
|
||||
#
|
||||
#use strict;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %deplist;
|
||||
|
||||
#open class file and write preamble
|
||||
open(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";
|
||||
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";
|
||||
|
||||
foreach my $filename (glob "bn*.c") {
|
||||
foreach my $filename (glob 'bn*.c') {
|
||||
my $define = $filename;
|
||||
|
||||
print "Processing $filename\n";
|
||||
@ -18,106 +19,109 @@ print "Processing $filename\n";
|
||||
# convert filename to upper case so we can use it as a define
|
||||
$define =~ tr/[a-z]/[A-Z]/;
|
||||
$define =~ tr/\./_/;
|
||||
print CLASS "#define $define\n";
|
||||
print {$class} "#define $define\n";
|
||||
|
||||
# now copy text and apply #ifdef as required
|
||||
my $apply = 0;
|
||||
open(SRC, "<$filename");
|
||||
open(OUT, ">tmp");
|
||||
open(my $src, '<', $filename);
|
||||
open(my $out, '>', 'tmp');
|
||||
|
||||
# first line will be the #ifdef
|
||||
my $line = <SRC>;
|
||||
my $line = <$src>;
|
||||
if ($line =~ /include/) {
|
||||
print OUT $line;
|
||||
print {$out} $line;
|
||||
} else {
|
||||
print OUT "#include <tommath.h>\n#ifdef $define\n$line";
|
||||
print {$out} "#include <tommath.h>\n#ifdef $define\n$line";
|
||||
$apply = 1;
|
||||
}
|
||||
while (<SRC>) {
|
||||
while (<$src>) {
|
||||
if (!($_ =~ /tommath\.h/)) {
|
||||
print OUT $_;
|
||||
print {$out} $_;
|
||||
}
|
||||
}
|
||||
if ($apply == 1) {
|
||||
print OUT "#endif\n";
|
||||
print {$out} "#endif\n";
|
||||
}
|
||||
close SRC;
|
||||
close OUT;
|
||||
close $src;
|
||||
close $out;
|
||||
|
||||
unlink($filename);
|
||||
rename("tmp", $filename);
|
||||
unlink $filename;
|
||||
rename 'tmp', $filename;
|
||||
}
|
||||
print CLASS "#endif\n\n";
|
||||
print {$class} "#endif\n\n";
|
||||
|
||||
# now do classes
|
||||
|
||||
foreach my $filename (glob "bn*.c") {
|
||||
open(SRC, "<$filename") or die "Can't open source file!\n";
|
||||
foreach my $filename (glob 'bn*.c') {
|
||||
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
|
||||
$filename =~ tr/[a-z]/[A-Z]/;
|
||||
$filename =~ tr/\./_/;
|
||||
|
||||
print CLASS "#if defined($filename)\n";
|
||||
print {$class} "#if defined($filename)\n";
|
||||
my $list = $filename;
|
||||
|
||||
# scan for mp_* and make classes
|
||||
while (<SRC>) {
|
||||
while (<$src>) {
|
||||
my $line = $_;
|
||||
while ($line =~ m/(fast_)*(s_)*mp\_[a-z_0-9]*/) {
|
||||
$line = $';
|
||||
# now $& is the match, we want to skip over LTM keywords like
|
||||
# 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 = $&;
|
||||
$a =~ tr/[a-z]/[A-Z]/;
|
||||
$a = "BN_" . $a . "_C";
|
||||
$a = 'BN_' . $a . '_C';
|
||||
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";
|
||||
close SRC;
|
||||
print {$class} "#endif\n\n";
|
||||
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";
|
||||
close CLASS;
|
||||
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;
|
||||
|
||||
#now let's make a cool call graph...
|
||||
|
||||
open(OUT,">callgraph.txt");
|
||||
$indent = 0;
|
||||
foreach (keys %deplist) {
|
||||
$list = "";
|
||||
draw_func(@deplist{$_});
|
||||
print OUT "\n\n";
|
||||
open(my $out, '>', 'callgraph.txt');
|
||||
my $indent = 0;
|
||||
my $list;
|
||||
foreach (sort keys %deplist) {
|
||||
$list = '';
|
||||
draw_func($deplist{$_});
|
||||
print {$out} "\n\n";
|
||||
}
|
||||
close(OUT);
|
||||
close $out;
|
||||
|
||||
sub draw_func()
|
||||
sub draw_func
|
||||
{
|
||||
my @funcs = split(",", $_[0]);
|
||||
if ($list =~ /@funcs[0]/) {
|
||||
my @funcs = split ',', $_[0];
|
||||
if ($list =~ /$funcs[0]/) {
|
||||
return;
|
||||
} else {
|
||||
$list = $list . @funcs[0];
|
||||
$list = $list . $funcs[0];
|
||||
}
|
||||
if ($indent == 0) { }
|
||||
elsif ($indent >= 1) { print OUT "| " x ($indent - 1) . "+--->"; }
|
||||
print OUT @funcs[0] . "\n";
|
||||
if ($indent == 0) {
|
||||
} elsif ($indent >= 1) {
|
||||
print {$out} '| ' x ($indent - 1) . '+--->';
|
||||
}
|
||||
print {$out} $funcs[0] . "\n";
|
||||
shift @funcs;
|
||||
my $temp = $list;
|
||||
foreach my $i (@funcs) {
|
||||
++$indent;
|
||||
draw_func(@deplist{$i});
|
||||
draw_func($deplist{$i}) if exists $deplist{$i};
|
||||
--$indent;
|
||||
}
|
||||
$list = $temp;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
||||
30
filter.pl
30
filter.pl
@ -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)
|
||||
|
||||
$dst = shift;
|
||||
$ins = shift;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
open(SRC,"<$dst");
|
||||
open(INS,"<$ins");
|
||||
open(TMP,">tmp.delme");
|
||||
open(my $src, '<', shift);
|
||||
open(my $ins, '<', shift);
|
||||
open(my $tmp, '>', 'tmp.delme');
|
||||
|
||||
$l = 0;
|
||||
while (<SRC>) {
|
||||
my $l = 0;
|
||||
while (<$src>) {
|
||||
if ($_ =~ /START_INS/) {
|
||||
print TMP $_;
|
||||
print {$tmp} $_;
|
||||
$l = 1;
|
||||
while (<INS>) {
|
||||
print TMP $_;
|
||||
while (<$ins>) {
|
||||
print {$tmp} $_;
|
||||
}
|
||||
close INS;
|
||||
close $ins;
|
||||
} elsif ($_ =~ /END_INS/) {
|
||||
print TMP $_;
|
||||
print {$tmp} $_;
|
||||
$l = 0;
|
||||
} elsif ($l == 0) {
|
||||
print TMP $_;
|
||||
print {$tmp} $_;
|
||||
}
|
||||
}
|
||||
|
||||
close TMP;
|
||||
close SRC;
|
||||
close $tmp;
|
||||
close $src;
|
||||
|
||||
# $Source$
|
||||
# $Revision$
|
||||
|
||||
19
gen.pl
19
gen.pl
@ -4,16 +4,17 @@
|
||||
# add the whole source without any makefile troubles
|
||||
#
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
open( OUT, ">mpi.c" ) or die "Couldn't open mpi.c for writing: $!";
|
||||
foreach my $filename (glob "bn*.c") {
|
||||
open( SRC, "<$filename" ) or die "Couldn't open $filename for reading: $!";
|
||||
print OUT "/* Start: $filename */\n";
|
||||
print OUT while <SRC>;
|
||||
print OUT "\n/* End: $filename */\n\n";
|
||||
close SRC or die "Error closing $filename after reading: $!";
|
||||
open(my $out, '>', 'mpi.c') or die "Couldn't open mpi.c for writing: $!";
|
||||
foreach my $filename (glob 'bn*.c') {
|
||||
open(my $src, '<', $filename) or die "Couldn't open $filename for reading: $!";
|
||||
print {$out} "/* Start: $filename */\n";
|
||||
print {$out} $_ while <$src>;
|
||||
print {$out} "\n/* End: $filename */\n\n";
|
||||
close $src or die "Error closing $filename after reading: $!";
|
||||
}
|
||||
print OUT "\n/* EOF */\n";
|
||||
close OUT or die "Error closing mpi.c after writing: $!";
|
||||
print {$out} "\n/* EOF */\n";
|
||||
close $out or die "Error closing mpi.c after writing: $!";
|
||||
|
||||
system('perl -pli -e "s/\s*$//" mpi.c');
|
||||
|
||||
3
makefile
3
makefile
@ -193,3 +193,6 @@ zipup:
|
||||
new_file:
|
||||
bash updatemakes.sh
|
||||
perl dep.pl
|
||||
|
||||
perlcritic:
|
||||
perlcritic *.pl
|
||||
|
||||
@ -4,18 +4,21 @@
|
||||
# wrapped at 80 chars
|
||||
#
|
||||
# Tom St Denis
|
||||
@a = split(" ", $ARGV[1]);
|
||||
$b = "$ARGV[0]=";
|
||||
$len = length($b);
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my @a = split ' ', $ARGV[1];
|
||||
my $b = $ARGV[0] . '=';
|
||||
my $len = length $b;
|
||||
print $b;
|
||||
foreach my $obj (@a) {
|
||||
$len = $len + length($obj);
|
||||
$len = $len + length $obj;
|
||||
$obj =~ s/\*/\$/;
|
||||
if ($len > 100) {
|
||||
printf "\\\n";
|
||||
$len = length($obj);
|
||||
$len = length $obj;
|
||||
}
|
||||
print "$obj ";
|
||||
print $obj . ' ';
|
||||
}
|
||||
|
||||
print "\n\n";
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user