123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329 |
- use strict;
- use warnings;
- use File::Basename;
- my $root=$ARGV[0] || ".";
- my $incdir = "$root/include/curl";
- my $docdir = "$root/docs";
- my $libdocdir = "$docdir/libcurl";
- my $errcode = 0;
- my %syminver;
- my %hdr;
- my %funcman;
- my %optman;
- sub scan_header {
- my ($f)=@_;
- my $line = "";
- my $incomment = 0;
- my $inenum = 0;
- open(my $h, "<", "$f");
- while(<$h>) {
- s/^\s*(.*?)\s*$/$1/;
-
- if($incomment) {
- if($_ !~ /.*?\*\/\s*(.*)$/) {
- next;
- }
- $_ = $1;
- $incomment = 0;
- }
- if($line ne "") {
-
- $_ = "$line $1";
- $line = "";
- }
-
- while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) {
- $_ = "$1 $2";
- }
- if($_ =~ /^(.*)\/\*/) {
- $_ = "$1 ";
- $incomment = 1;
- }
- s/^\s*(.*?)\s*$/$1/;
-
- if($_ =~ /^(?:#|$)/) {
- next;
- }
-
- if($_ !~ /[;,{}]$/) {
-
- $line = $_;
- next;
- }
- if($_ =~ /CURLOPTDEPRECATED\(/) {
-
- if($_ !~ /CURLOPTDEPRECATED\(\s*(\S+)\s*,(?:.*?,){2}\s*(.*?)\s*,.*"\)/) {
-
- $line = $_;
- next;
- }
- $hdr{$1} = $2;
- }
- elsif($_ =~ /CURLOPT\(/) {
-
- if($_ !~ /CURLOPT\(\s*(\S+)\s*(?:,.*?){2}\)/) {
-
- $line = $_;
- next;
- }
- $hdr{$1} = "X";
- }
- else {
- my $version = "X";
-
- if($_ =~ /CURL_DEPRECATED\(/) {
- if($_ !~ /^(.*)CURL_DEPRECATED\(\s*(\S+?)\s*,.*?"\)(.*)$/) {
-
- $line = $_;
- next;
- }
- $version = $2;
- $_ = "$1 $3";
- }
- if($_ =~ /^CURL_EXTERN\s+.*\s+(\S+?)\s*\(/) {
-
- $hdr{$1} = $version;
- }
- elsif($inenum && $_ =~ /(\w+)\s*[,=}]/) {
-
- $hdr{$1} = $version;
- }
- }
-
- $inenum |= ($_ =~ /\benum\b/);
- if($_ =~ /}/) {
- $inenum = 0;
- }
- }
- close $h;
- }
- sub scan_man_for_opts {
- my ($f, $prefix)=@_;
- my $opt = "";
- my $line = "";
- open(my $m, "<", "$f");
- while(<$m>) {
- if($_ =~ /^\./) {
-
- my $o = $opt;
- $opt = "";
- if($_ =~ /^\.IP\s+((?:$prefix)_\w+)/) {
-
- $opt = $1;
- }
- $_ = $line;
- $line = "";
- s/\\f.//g;
- s/\s+/ /g;
- if($o) {
- $funcman{$o} = "X";
-
- while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) {
- $funcman{$o} = $1 || "?";
- $_ = $2;
- }
- }
- }
- else {
-
- $line .= $_;
- }
- }
- close $m;
- }
- sub scan_man_page {
- my ($path, $sym, $table)=@_;
- my $version = "X";
- if(open(my $fh, "<", "$path")) {
- my $section = "";
- my $line = "";
- while(<$fh>) {
- if($_ =~ /\.so\s+man3\/(.*\.3\b)/) {
-
- scan_man_page(dirname($path) . "/$1", $sym, $table);
- $version = exists($$table{$sym})? $$table{$sym}: $version;
- }
- elsif($_ =~ /^\./) {
-
- if($_ =~ /^\.SH\b\s*(\w*)/) {
-
- my $sh = $section;
- $section = $1;
- $_ = $line;
- $line = "";
- s/\\f.//g;
- s/\s+/ /g;
- s/\\f.//g;
- s/\s+/ /g;
- if($sh =~ /DESCRIPTION|DEPRECATED/) {
- while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) {
-
- if($version ne "X" && $version ne "?") {
- if($1 && $1 ne $version) {
- print "error: $sym manpage lists unmatching deprecation versions $version and $1\n";
- $errcode++;
- }
- }
- else {
- $version = $1 || "?";
- }
- $_ = $2;
- }
- }
- }
- }
- else {
-
- $line .= $_;
- }
- }
- close $fh;
- $$table{$sym} = $version;
- }
- }
- open(my $fh, "<", "$libdocdir/symbols-in-versions") ||
- die "$libdocdir/symbols-in-versions";
- while(<$fh>) {
- if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) {
- if($3 eq "") {
- $syminver{$1} = "X";
- if($2 ne "" && $2 ne ".") {
- $syminver{$1} = $2;
- }
- }
- }
- }
- close($fh);
- opendir(my $dh, $incdir) || die "Can't opendir $incdir";
- my @hfiles = grep { /\.h$/ } readdir($dh);
- closedir $dh;
- for(@hfiles) {
- scan_header("$incdir/$_");
- }
- foreach my $sym (keys %hdr) {
- if($sym =~/^(?:curl|curlx)_\w/) {
- scan_man_page("$libdocdir/$sym.3", $sym, \%funcman);
- }
- }
- scan_man_for_opts("$libdocdir/curl_easy_setopt.3", "CURLOPT");
- scan_man_for_opts("$libdocdir/curl_easy_getinfo.3", "CURLINFO");
- foreach my $sym (keys %syminver) {
- if($sym =~ /^(?:CURLOPT|CURLINFO)_\w+$/) {
- scan_man_page("$libdocdir/opts/$sym.3", $sym, \%optman);
- }
- }
- my %keys = (%syminver, %funcman, %optman, %hdr);
- my $leader = <<HEADER
- Legend:
- <empty> Not listed
- X Not deprecated
- ? Deprecated in unknown version
- x.yy.z Deprecated in version x.yy.z
- Symbol symbols-in func man opt man .h
- -versions
- HEADER
- ;
- foreach my $sym (sort {$a cmp $b} keys %keys) {
- if($sym =~ /^(?:CURLOPT|CURLINFO|curl|curlx)_\w/) {
- my $s = exists($syminver{$sym})? $syminver{$sym}: " ";
- my $f = exists($funcman{$sym})? $funcman{$sym}: " ";
- my $o = exists($optman{$sym})? $optman{$sym}: " ";
- my $h = exists($hdr{$sym})? $hdr{$sym}: " ";
- my $r = " ";
-
-
- "$f$o$h" =~ /[X ]{3}/ && next;
-
- foreach my $k ($s, $f, $o, $h) {
- $r = $r eq " "? $k: $r;
- if($k ne " " && $r ne $k) {
- if($r eq "?") {
- $r = $k ne "X"? $k: "!";
- }
- elsif($r eq "X" || $k ne "?") {
- $r = "!";
- }
- }
- }
- if($r eq "!") {
- print $leader;
- $leader = "";
- printf("%-38s %-11s %-9s %-9s %s\n", $sym, $s, $f, $o, $h);
- $errcode++;
- }
- }
- }
- exit $errcode;
|