From 226d85341023d6e8dbe4640d2f034a00af3cb19d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Duval?= Date: Thu, 14 Sep 2006 09:11:01 +0000 Subject: [PATCH] a tool to check a docbook file against a C++ header : it will output methods not found in the docbook file typical command line : perl src/tools/docbook/headersampler/HeaderSampler.pl headers/os/midi2/MidiConsumer.h src/documentation/haiku_book/midi/midi2consumer.xml git-svn-id: file:///srv/svn/repos/haiku/haiku/trunk@18829 a95241bf-73f2-0310-859d-f6bbb57e9c96 --- .../docbook/headersampler/HeaderSampler.pl | 398 ++++++++++++++++++ 1 file changed, 398 insertions(+) create mode 100644 src/tools/docbook/headersampler/HeaderSampler.pl diff --git a/src/tools/docbook/headersampler/HeaderSampler.pl b/src/tools/docbook/headersampler/HeaderSampler.pl new file mode 100644 index 0000000000..bf37b543ad --- /dev/null +++ b/src/tools/docbook/headersampler/HeaderSampler.pl @@ -0,0 +1,398 @@ +#!/bin/perl + +# headerSampler.pl, Copyright (C) 1997, Mizutori Tetsuya +# +# January 7, 1997, February 4, 1997. +# Usage: +# Drag and drop the C++ header files onto this 'header.pl' script + +use integer; +#use strict ('subs','vars'); + +my $gMAC = ( $ENV{'HOME'} =~ /^$/ ); +#if ( $gMAC ) { print "I love Macintosh.\n"; } +my $gScope = ""; +my $gSentence = ""; +my $gDocbookpath = ""; + +# if the command line includes no file list, then prompt the choose dialog. +#push(@ARGV, ChooseFile()) unless defined @ARGV; + +DoMain(); + +ExitToShell(); + +# + +################ +# DoMain +################ + +sub DoMain { + my $filepath; + my $countFiles = 0; + + $filepath = $ARGV[0]; + $gDocbookpath = $ARGV[1]; +# foreach $filepath (@ARGV) { + my ($creator,$type) = GetFileInfo($filepath); + + $countFiles++; + #print "[$countFiles] = ['$creator','$type'] $filepath\n"; + +# skip if the file is not 'TEXT' nor '*.h'. + next if ($type ne 'TEXT'); + next unless ($filepath =~ /\.h$/); + + $gScope = "private:"; + $gSentence = ""; + @gComment = (); + $gIsIgnoring = 0; + + open(IN, $filepath) || die "Can't open '$filepath'"; + while () { + chomp; + HandleTextline(); + } + close IN; +# } +} + + +################ +# HandleTextline +################ + +sub HandleTextline { + +# fetch the commant part if it exists. + if ( m/\/\/.*$/ ) { $gComment[$#gComment + 1] = $&; } + +# ignore the comment part in the line. + s/^(.*)\/\/.*$/$1/; + +# trim the line. + s/^[ \t]+//; + s/[ \t]+$//; + + SWITCH: { + + # skip 'typedef' or 'struct' region. + (/^typedef/ || /^struct/) && do { + $gIsIgnoring = 1; + last SWITCH; + }; + + # skip this line if it begins with "#ifdef", "#endif", and others. + /^#/ && do { + @gComment = (); + last SWITCH; + }; + + # ignore this line if it begins with "public" and other keywords. + (/^public:/ || /^protected:/ || /^private:/) && do { + $gScope = $_; + $gSentence = ""; + @gComment = (); + last SWITCH; + }; + + # skip this line if it ends with "}???;". + /\}.*;$/ && do { + $gSentence = ""; + @gComment = (); + $gIsIgnoring = 0; + last SWITCH; + }; + + # test if end of 'typedef' or 'struct' region. + ($gIsIgnoring) && do { + last SWITCH; + }; + + # append this line to my sentence. + do { + $gSentence .= "\t" unless $gSentence =~ /^$/; + $gSentence .= $_; + }; + + # handle my sentence if the line ends with ";". + /;$/ && do { + $_ = $gSentence; + ApplySentence(); + $gSentence = ""; + @gComment = (); + last SWITCH; + }; + } +} + + +################ +# ApplySentence +################ + +sub ApplySentence { +# my ($textline) = @_; + +# eliminate the duplicate spaces to a blank space. + s/[ \t]+/ /g; + +# eliminate the ";" character at the tail end. + s/[ ]*;$//; + + #if ( s/[ ]*const$// ) { PrintFunction(); } # if the function has 'const'modifier. + #elsif ( /\)$/ ) { PrintFunction(); } + if ( /\)/ ) { PrintFunction(); } + #else { PrintVariable(); } + +} + + +################ +# PrintFunction +################ + +sub PrintFunction { +# print a comment. +# my $textline; +# if ( $#gComment >= 0 ) { +# foreach $textline (@gComment) { +# print "\t\t$textline\n"; +# } +# } + + if (! ($gScope =~ /^public/ )) { + return; + } + +# print a scope sign. +#print WhichScope(); + +# print "#$_\n"; + my $functype, $funcname, $funcargs; + +# split line to ( ) parts. + m/[ ]*\([ ]*(.*)[ ]*\)[ ]*([const]*)/; + $funcname = $`; + $funcargs = $1; + $funcconst = $2; + $funcname =~ s/[ ]+$//; + $funcargs =~ s/[ ]+$//; + +# handle func name. + split(/[ ]+/,$funcname); + $funcname = pop(); + $functype = join(' ', @_); + +# handle func arg list. +# split(/[ ]*,[ ]*/, $funcargs); +# my @args = @_; +# for (@args) { +# if ( /[ ]*=[ ]*/ ) { $_ = $`; } # for default value; ex. (short X = 100) +# split(/[ ]+/); +# pop(); +# $_ = join(' ',@_); +# } +# $funcargs = join(', ', @args); + + if ($functype) { + $functype = $functype . " " + } + if ($funcconst) { + $funcconst = " " . $funcconst + } + $_ = $functype . $funcname . "(" . $funcargs . ")" . $funcconst; + ValidateDocbook(); +# print "FUNC = TYPE($funcname)+NAME($funcname)+ARGS($funcargs)\n"; +# print $funcname . "\t" x CalcTabs($funcname,5) . $functype . "(" . $funcargs . ")"; +# print "\n"; +} + +################ +# ValidateDocbook +################ + +sub ValidateDocbook { + + open(IN2, $gDocbookpath) || die "Can't open '$gDocbookpath'"; + my $line = ""; + my $last = ""; + my $input = $_; + my $found = 0; + while () { + chomp; + s/^[\t ]+//; + $line = $last . $_ ; + if ( index($line, $input) >= 0 ) { + $found = 1; + break; + } + $last = $_; + } + if ( $found == 0 ) { + print $input . "\n" ; + } + close IN2; +} + + +################ +# PrintVariable +################ + +sub PrintVariable { + +# print a scope sign. + print WhichScope(); + +# print "#$_\n"; + my $vartype; + my $varname = $_; + my $varargs = ""; + +# split line to [ ] parts. + if ( m/[ ]*\[[ ]*(.*)[ ]*\][ ]*/ ) { + $varname = $`; + $varargs = $1; + $varname =~ s/[ ]+$//; + $varargs =~ s/[ ]+$//; + } + + split(/[ ]+/,$varname); + my $vartype = join(' ', @_[0..($#_ - 1)]); + my $varname = $_[$#_]; + +# print variable definition + print $vartype . "\t" x CalcTabs($vartype,5). $varname; + if ( $varargs ne "" ) { print "[" . $varargs . "]"; } + +# print a comment. + if ( $#gComment >= 0 ) { + print "\t" x CalcTabs($varname,4); + print join("\t",@gComment); + } + + print "\n"; +} + + +################ +# WhichScope() +################ + +sub WhichScope { +# my ($textline) = @_; + my $key; + my $str; + + SWITCH: { + ( s/^virtual[ ]*// ) && do { $key = "v"; last SWITCH; }; + ( s/^static[ ]*// ) && do { $key = "s"; last SWITCH; }; + do { $key = "."; last SWITCH; } + }; + + SWITCH: { + ($gScope =~ /^public/ ) && do { $str = "=" . $key . "="; last SWITCH; }; + ($gScope =~ /^protected/ ) && do { $str = ">" . $key . ">"; last SWITCH; }; + ($gScope =~ /^private/ ) && do { $str = "(" . $key . ")"; last SWITCH; }; + do { $str = " " . $key . " "; last SWITCH; }; + }; + + return $str . "\t"; +} + + +################ +# StringWidth +################ + +sub StringWidth { + my ($str) = @_; + +# width table of 10-point Geneva font + my %width_table = ( + ' '=> 3, '!'=> 4, '"'=> 5, '#'=> 9, '\$'=> 7, '%'=>10, '&'=> 8, '\''=> 3, + '('=> 6, ')'=> 6, '*'=> 7, '+'=> 8, ','=> 4, '-'=> 7, '.'=> 3, '/'=> 6, + '0'=> 7, '1'=> 7, '2'=> 7, '3'=> 7, '4'=> 7, '5'=> 7, '6'=> 7, '7'=> 7, + '8'=> 7, '9'=> 7, ':'=> 3, ';'=> 4, '<'=> 5, '='=> 7, '>'=> 5, '?'=> 7, + '@'=> 9, 'A'=> 6, 'B'=> 7, 'C'=> 6, 'D'=> 7, 'E'=> 6, 'F'=> 6, 'G'=> 6, + 'H'=> 7, 'I'=> 4, 'J'=> 6, 'K'=> 7, 'L'=> 6, 'M'=> 9, 'N'=> 7, 'O'=> 6, + 'P'=> 7, 'Q'=> 6, 'R'=> 7, 'S'=> 6, 'T'=> 6, 'U'=> 7, 'V'=> 6, 'W'=>10, + 'X'=> 6, 'Y'=> 6, 'Z'=> 6, '['=> 5, '\\'=> 5, ']'=> 5, '^'=> 5, '_'=> 7, + '`'=> 4, 'a'=> 5, 'b'=> 6, 'c'=> 5, 'd'=> 5, 'e'=> 5, 'f'=> 4, 'g'=> 5, + 'h'=> 6, 'i'=> 4, 'j'=> 5, 'k'=> 6, 'l'=> 4, 'm'=> 9, 'n'=> 6, 'o'=> 5, + 'p'=> 6, 'q'=> 5, 'r'=> 6, 's'=> 5, 't'=> 4, 'u'=> 6, 'v'=> 6, 'w'=> 8, + 'x'=> 6, 'y'=> 6, 'z'=> 5, '{'=> 5, '|'=> 4, '}'=> 5, '~'=> 7 +); + +# my $tab_width = 4 * $width_table{'0'}; + + my $sum = 0; + my $c; + + foreach $c ( split(//,$str) ) { + $sum += $width_table{$c}; +# print "'$c' =>$width_table{$c}/$sum\n"; + } + + return $sum; +} + + +################ +# CalcTabs +################ + +sub CalcTabs { + my ($str,$tabn) = @_; + my $tab_width = 4 * StringWidth('0'); + my $tab_position = $tabn * $tab_width; + my $skip_dots = $tab_position - StringWidth($str); + my $more_tabs = 1; + + if ( $skip_dots > 0 ) { + $more_tabs += ($skip_dots - 1) / $tab_width; + } + +# print "["; print "$more_tabs:$skip_dots"; print "]"; + + return $more_tabs; +} + + +################ +# ExitToShell() +################ +# Macintosh specific routine + +sub ExitToShell { + +# if the runtime environment is a Macintosh. + &MacPerl'Quit(1) if $gMAC; + +# else then it is a Unix. + exit(0); +} + + +################ +# GetFileInfo() +################ +# Macintosh specific routine +# Returns a list ($creator,$type) + +sub GetFileInfo { + my ($filepath) = @_; + +# if the runtime environment is a Macintosh. + return &MacPerl'GetFileInfo($filepath) if $gMAC; + +# else then it is a Unix and if the file is a text file. + return ('????', 'TEXT') if -T $filepath; + +# otherwise returns nil. + return ('????', '????'); +} + +### end of script ###