diff options
Diffstat (limited to 'perl/BerkeleyDB/scan')
| -rw-r--r-- | perl/BerkeleyDB/scan | 238 |
1 files changed, 238 insertions, 0 deletions
diff --git a/perl/BerkeleyDB/scan b/perl/BerkeleyDB/scan new file mode 100644 index 00000000..c501f3c4 --- /dev/null +++ b/perl/BerkeleyDB/scan @@ -0,0 +1,238 @@ +#!/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 + )) . ')' ; + +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 + ); + +my $filler = ' ' x 26 ; + +chdir "libraries" || die "Cannot chdir into './libraries': $!\n"; + +foreach my $name (sort tuple glob "[2-9]*") +{ + next if $name =~ /(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__ + |