Viewing file:  scan.pl (5.59 KB) -rw-rw-rw-
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/local/bin/perl
my $ignore_re = '^(' . join("|",
qw(
_
[a-z]
DBM
DBC
DB_AM_
DB_BT_
DB_RE_
DB_HS_
DB_FUNC_
DB_DBT_
DB_DBM
DB_TSL
MP
TXN
DB_TXN_GETPGNOS
DB_TXN_BACKWARD_ALLOC
DB_ALIGN8
)) . ')' ;
my %ignore_def = map {$_, 1} qw() ;
%ignore_enums = map {$_, 1} qw( ACTION db_status_t db_notices db_lockmode_t ) ;
my %ignore_exact_enum = map { $_ => 1}
qw(
DB_TXN_GETPGNOS
DB_TXN_BACKWARD_ALLOC
);
my $filler = ' ' x 26 ;
chdir "libraries" || die "Cannot chdir into './libraries': $!\n";
foreach my $name (sort tuple glob "[2-9]*")
{
next if $name =~ /(NOHEAP|NC|private)$/;
my $inc = "$name/include/db.h" ;
next unless -f $inc ;
my $file = readFile($inc) ;
StripCommentsAndStrings($file) ;
my $result = scan($name, $file) ;
print "\n\t#########\n\t# $name\n\t#########\n\n$result"
if $result;
}
exit ;
sub scan
{
my $version = shift ;
my $file = shift ;
my %seen_define = () ;
my $result = "" ;
if (1) {
# Preprocess all tri-graphs
# including things stuck in quoted string constants.
$file =~ s/\?\?=/#/g; # | ??=| #|
$file =~ s/\?\?\!/|/g; # | ??!| ||
$file =~ s/\?\?'/^/g; # | ??'| ^|
$file =~ s/\?\?\(/[/g; # | ??(| [|
$file =~ s/\?\?\)/]/g; # | ??)| ]|
$file =~ s/\?\?\-/~/g; # | ??-| ~|
$file =~ s/\?\?\//\\/g; # | ??/| \|
$file =~ s/\?\?</{/g; # | ??<| {|
$file =~ s/\?\?>/}/g; # | ??>| }|
}
while ( $file =~ /^\s*#\s*define\s+([\$\w]+)\b(?!\()\s*(.*)/gm )
{
my $def = $1;
my $rest = $2;
my $ignore = 0 ;
$ignore = 1 if $ignore_def{$def} || $def =~ /$ignore_re/o ;
# Cannot do: (-1) and ((LHANDLE)3) are OK:
#print("Skip non-wordy $def => $rest\n"),
$rest =~ s/\s*$//;
#next if $rest =~ /[^\w\$]/;
#print "Matched $_ ($def)\n" ;
next if $before{$def} ++ ;
if ($ignore)
{ $seen_define{$def} = 'IGNORE' }
elsif ($rest =~ /"/)
{ $seen_define{$def} = 'STRING' }
else
{ $seen_define{$def} = 'DEFINE' }
}
foreach $define (sort keys %seen_define)
{
my $out = $filler ;
substr($out,0, length $define) = $define;
$result .= "\t$out => $seen_define{$define},\n" ;
}
while ($file =~ /\btypedef\s+enum\s*{(.*?)}\s*(\w+)/gs )
{
my $enum = $1 ;
my $name = $2 ;
my $ignore = 0 ;
$ignore = 1 if $ignore_enums{$name} ;
#$enum =~ s/\s*=\s*\S+\s*(,?)\s*\n/$1/g;
$enum =~ s/^\s*//;
$enum =~ s/\s*$//;
my @tokens = map { s/\s*=.*// ; $_} split /\s*,\s*/, $enum ;
my @new = grep { ! $Enums{$_}++ } @tokens ;
if (@new)
{
my $value ;
if ($ignore)
{ $value = "IGNORE, # $version" }
else
{ $value = "'$version'," }
$result .= "\n\t# enum $name\n";
my $out = $filler ;
foreach $name (@new)
{
next if $ignore_exact_enum{$name} ;
$out = $filler ;
substr($out,0, length $name) = $name;
$result .= "\t$out => $value\n" ;
}
}
}
return $result ;
}
sub StripCommentsAndStrings
{
# Strip C & C++ coments
# From the perlfaq
$_[0] =~
s{
/\* ## Start of /* ... */ comment
[^*]*\*+ ## Non-* followed by 1-or-more *'s
(
[^/*][^*]*\*+
)* ## 0-or-more things which don't start with /
## but do end with '*'
/ ## End of /* ... */ comment
| ## OR C++ Comment
// ## Start of C++ comment //
[^\n]* ## followed by 0-or-more non end of line characters
| ## OR various things which aren't comments:
(
" ## Start of " ... " string
(
\\. ## Escaped char
| ## OR
[^"\\] ## Non "\
)*
" ## End of " ... " string
| ## OR
' ## Start of ' ... ' string
(
\\. ## Escaped char
| ## OR
[^'\\] ## Non '\
)*
' ## End of ' ... ' string
| ## OR
. ## Anything other char
[^/"'\\]* ## Chars which doesn't start a comment, string or escape
)
}{$2}gxs;
# Remove double-quoted strings.
#$_[0] =~ s#"(\\.|[^"\\])*"##g;
# Remove single-quoted strings.
#$_[0] =~ s#'(\\.|[^'\\])*'##g;
# Remove leading whitespace.
$_[0] =~ s/\A\s+//m ;
# Remove trailing whitespace.
$_[0] =~ s/\s+\Z//m ;
# Replace all multiple whitespace by a single space.
#$_[0] =~ s/\s+/ /g ;
}
sub readFile
{
my $filename = shift ;
open F, "<$filename" || die "Cannot open $filename: $!\n" ;
local $/ ;
my $x = <F> ;
close F ;
return $x ;
}
sub tuple
{
my (@a) = split(/\./, $a) ;
my (@b) = split(/\./, $b) ;
if (@a != @b) {
my $diff = @a - @b ;
push @b, (0 x $diff) if $diff > 0 ;
push @a, (0 x -$diff) if $diff < 0 ;
}
foreach $A (@a) {
$B = shift @b ;
$A == $B or return $A <=> $B ;
}
return 0;
}
__END__
|