#! /usr/bin/perl -w

# ugly hack by Joerg Arndt (arndt (AT) jjj.de)
# version: 2005-February-11 (14:15)

#
# usage:
#   autodoc.pl [regexp] < some.h
#   autodoc.pl some.h [regexp] > some.h-doc.txt
#

$DEBUG = 0;

####################################################

$hline = '';      # line from header which contains $funcnm
$hlinect = 0;     # count lines in header file

$funcnm = '';     # name of the function to be searched in $srcfile
#$funcsig = '';    # signature of the function
$patall = '^';    # match-all pattern
$funcpat = $patall;   # pattern that funcnm has to match
$patq = 0;        # whether we have a pattern to match

$srcfile = '';    # source file name given in header
$srcfilepr = 0;   # whether source file name already printed
$srcopenq = 0;    # whether srcfile is open
$srclinect = 0;   # line counter in srcfile

$commentsq = 1;   # whether comments before function body will be printed
$pdiscardedq = 1; # whether to print discarded lines from header

$showaux = 1;     # whether to print funcs marked as auxil
$echotune = 1;    # whether to show tuning #defines in srcfiles

$echoclass = 1;   # whether to echo class declarations
$echocolon = 1;   # whether to echo lines starting with '//:'
$echoregion = 1;  # whether to regions between '//<<' and '//>>'
$echostatic = 1;  # whether to echo static funcs
$echoinline = 1;  # whether to echo inline funcs from srcfiles

#$typepat = '(char)|(int)|(long)|(Complex)|(float)|(double)';
$idpat   = '\b[a-zA-Z_][a-zA-Z0-9_]*\b';  # regex for C-identifier

$templateq = 0; # whether we just stepped on a 'template <typename Type...>' line

####################################################

#print '// -*- C++ -*-' . "\n";
#print '// generated by jj\'s autodoc, do not edit.' . "\n";
#print "\n";


#if ( ! $ARGV[0] )  { die "FATAL: need (header-)filename to read from\n"; }
#$hdrfile = $ARGV[0];
#open HDRFILE, "<$hdrfile"  ||  die " ***** CANNOT OPEN FILE hdrfile=[$hdrfile] ***** ";
#open HDRFILE, "<"  ||  die " ***** CANNOT OPEN FILE hdrfile=[$hdrfile] ***** ";


if ( $ARGV[0] )  { $funcpat = $ARGV[0]; }
if ( $funcpat =~ /^ *$/ )  { $funcpat = $patall; }


#print "// ===== FUNCTIONS declared in $hdrfile";
if ( $funcpat ne $patall )
{
    $patq = 1;
    print "// ... matching \"$funcpat\"";
    $echotune = 0;
    $echoclass = 0;
    $echocolon = 0;
    $echoregion = 0;
}
print "\n";


while ( <STDIN> )
{
    $hlinect++;
    $DEBUG && print STDERR "# $hlinect: (main)\n";

    ### echo region if requested
    if ( /^\/\/<</ ) # start pattern == '//<<'
    {
        print "\n";
        while ( <STDIN> )
        {
            $hlinect++;
            $DEBUG && print STDERR "# $hlinect: (main)\n";
            $hlinect++;
            if ( /^\/\/>>/ )    # end pattern == '//>>'
            {
                $echoregion  &&  print "\n";
                goto dortunten;
            }
            $echoregion  &&  print;
        }
        die 'AARGH, unexpected end of input (no //>> after //<<) !';
    }


    ### echo line after pattern == '//:'
    if ( /^\/\/:(.*)$/ )
    {
        $echocolon  &&  print "//$1\n";
        next;
    }

    ### echo class definition:
    if ( /^class [^;]+$/ )
    {
        chomp;
        $echoclass  && print "$_;\n";
        while ( <STDIN> )
        {
            $hlinect++;
            $DEBUG && print STDERR "# $hlinect: (main)\n";

            if ( /^\{/ )  { last; }
            else  { $echoclass  && print; }
        }
        $echoclass  && print "\n";
        next;
    }

    if ( /^\/\/\.$/ )  # requested end processing for current comment
    {
        $DEBUG && print STDERR " req.end.proc.comment\n";
        while ( <STDIN> )
        {
            $hlinect++;
            $DEBUG && print STDERR "# $hlinect: (main)\n";
            if ( ! /^\/\// ) {  next; }
        }
    }

    if ( /^$/ )  { next; }  # empty line
    if ( /^\/\/ -----+$/ )  { next; }  # func/class end comment
#    if ( ! /\w/ )  { next; }  # nothing of interest

    chomp;

    if ( /jj_end_autodoc/ )  # requested end of processing
    {
        $DEBUG && print STDERR "  end(1) via jj_end_autodoc \n";
        goto undwech;
    }

    if ( /^template / )  { $templateq=1;  next; }

    $x = $_;

#    ( $x = $_ )  ||  die 'OOPS';
    if ( &fileq($x) )  # line containing a filename of interest
    {
        print STDERR "SRCFILE=$srcfile \n";
#        $funclst = ();
        $srcline = "";
        next;
    }

    if ( &funcq($x) )  # line containing a function declaration
    {
        $DEBUG && print STDERR "in header line: [[$x]]\n  func==[[$funcnm]]";

        if ( !($funcnm =~ $funcpat) )  # function name has to match $funcpat
        {
#            print STDERR " doesn't match funcpat==[[$funcpat]]\n";
            next;
        }

        if ( $auxq && !$showaux )  # skip if unwanted
        {
#            print STDERR " is auxiliary (suppressed)\n";
            next;
        }

        print STDERR "rettype=[[$rettype]]  funcnm=[[$funcnm]]\n";
        # inline or template funcs in header
        if ( ($rettype eq '') || ($rettype =~ /inline/) || $templateq )
        {
            $templateq = 0;

            $DEBUG && print STDERR "   $rettype $funcnm()  [hdr]\n";
            $DEBUG && print STDERR " x=[[$x]] rettype=[[$rettype]] funcnm=[[$funcnm]] \n";
            print "$x;\n";
#            if ( (__restrict =~ $_) && !(__restrict =~ $funcsig ) )
#            {
#                print '// RESTRICT diff: '." \n";
#                exit 9;
#            }

#            $srcsig = $x;
            while ( <STDIN> )  # print following nonempty lines
            {
                $hlinect++;
                $DEBUG && print STDERR "# $hlinect: (main.uglyloop.1)\n";

#                if ( /^\/\/./ )
#                {
#                    $DEBUG && print STDERR " req.end.proc.comment\n";
#                    while ( <STDIN> )
#                    {
#                        $hlinect++;
#                        $DEBUG && print STDERR "# $hlinect: (main)\n";
#                        
#                    }
#                    if ( ! /^\/\// ) {  next; }
#                }

                if ( /^\{/ )
                {
                    if ( ! /\}$/ )
                    {
                        while ( <STDIN> )
                        {
                            $hlinect++;
                            $DEBUG && print STDERR "# $hlinect: (main.uglyloop.2)\n";
                            if ( /^\}/ )
                            {
                                last;
                            }
                        }
                    }
                    last;
                }
                print;
#                $srcsig = $srcsig . $_;
            }
#            print STDERR "full srcsig=[[$srcsig]]\n";

            print "\n";
            next;
        }
#        push @funclst, ($funcnm);

        &scanfunc();
        next;
    }

#    if ( $x =~ /jj_end_autodoc/ )  # requested end of processing
#    {
#        $DEBUG && print STDERR "  end(2) via jj_end_autodoc \n";
#        goto undwech;
#    }

    # print discarded lines from header:
    if ( $pdiscardedq  && !($x =~ /^\#/) ) # unless preprocessor statements
    {
        print STDERR "IGNORING line $hlinect: [[$x]] \n";
    }

dortunten: ;
}

undwech:
#    print '// ---- end of autodoc ----'."\n";

exit 0;
####################################################
####################################################


sub fileq
# check if arg contains a filename
# if so, make sure file exists and can be read, then open it
{
    $_ = shift;
    if ( /^ *\/\/ *([^: ]+\.cc):/ ) # only *.cc files
    {
        $srcfile = "src/".$1;
        $srcfilepr = 0;

        if ( $srcopenq )  { close SRCFILE; }

        # does file exist ?
        if ( ! -f $srcfile )  { die " ***** srcfile=$srcfile NOT FOUND !  ***** \n"; }

        open SRCFILE, "<$srcfile"  ||  die " ***** CANNOT OPEN FILE srcfile=$srcfile ***** ";
        $srclinect = 0;

        return 1;
    }
    else  # no filename found ...
    {
        return 0;
    }
}
####################################################


sub funcq
# check whether line in header is a function declaration
# sets $funcnm, $rettype, $auxq, $funcsig
# returns:
#  0 iff no func decl
#  1 iff func decl
{
    $hline = shift;

    if ( $hline =~ /^ *\/\// )  { return 0; } # skip comments
    if ( $hline =~ /^\#/ )      { return 0; } # skip CPP lines
    if ( $hline =~ /[\{\}]/ )   { return 0; } # braces found

    # checking if function declaration:
    if ( $hline =~ /^([^ ].*)?($idpat)\(/ )
#    if ( $hline =~ /^([^ ].*)?($idpat)\(([^\)]*)/ )  # incl. sig
    {
#        $rettype = $1; # return type
        if ( $1 )  { $rettype = $1; }
        else       { $rettype = ''; }
        $funcnm = $2;  # function name

#        $funcsig = $3;  # function signature
#        print STDERR "funcsig = [[$funcsig]]\n";

        $declcomment = '';
        if ( $hline =~ /(\/\/.*)/ )  { $declcomment = " $1"; }

        $auxq = ( $declcomment =~ /aux/ ); # '// aux' marks as auxil func

        return 1;
    }
    else
    {
#        print STDERR "NOFUNC: [[$hline]] \n";
        return 0;
    }
}
####################################################

sub scanfunc
#
# read on in $srcfile and search for the definition of $funcnm:
# return whether function found was the function we searched for
#
{
#    print STDERR "# $hlinect: (scanfunc)\n";
    if ( ! $srcfilepr ) # need to print srcfile name
    {
        print "// ----- SRCFILE=$srcfile: -----\n";
        $srcfilepr = 1;
    }

doscan:
    while ( <SRCFILE> )  ### read until funcnm found
    {
        if ( $echotune  && /tuning +parameter/ )  # scan file for tuning parameters
        {
            print "$_";
            while ( <SRCFILE> )
            {
                if ( /^ *$/ )  # empty line
                {
                    print "\n";
                    goto nextsrcline;
                }
                else  { print $_; }
            }
        }

        $rettype = $srcline;  # line before funcnm == return type

        if ( $rettype =~ /static/ )  { $stq = 1; }
        else                         { $stq = 0; }

        if ( $rettype =~ /inline/ )  { $ilq = 1; }
        else                         { $ilq = 0; }

        $srcline = $_;
        $srclinect++;
#        print STDERR "src \#$srclinect==$srcline";

        if ( $srcline =~ /^[\w]+\(/ ) # found a function definition
        {
            if ( !($srcline =~ /^$funcnm\(/) )  # which is not the function searched
            {
                chomp $rettype;
                chomp $srcline;

                if ( !$stq && !$ilq )
                {
                    if ( !$patq )  # this is a workaround
                    {
                        print STDERR " UNDECLARED function:\n";
                        print STDERR " while searching rettype=[$rettype] funcnm=[$funcnm](...)" .
                            " declared in line \#$hlinect of the header file\n";
                        print STDERR " found at line \#$srclinect in $srcfile:\n";
                        print STDERR " $rettype $srcline\n";
                        die 'FATAL: undeclared function.';
                    }
                }
                else
                {
                    print STDERR " $rettype $srcline\n";
                }

                if ( ($stq && $echostatic) || ($ilq && $echoinline) )
                {
                    &echofunc();
                    goto nextsrcline;
                }
            }
        }

        if ( $srcline =~ /^$funcnm\(/ ) # found func of same name
        {
            &echofunc();
            return;
        }
      nextsrcline:;
    }

    die " ***** funcnm $funcnm(...)\n" . " ***** from line [[$hline]]\n" .
        " ***** NOT FOUND in file $srcfile ***** \n" .
        " while searching rettype=[$rettype] funcnm=[$funcnm](...)";
}
####################################################


sub echofunc
{
#    print STDERR "# $hlinect: (echofunc)\n";
    chomp $rettype;
    print "$rettype ";

    $_ = $srcline;
    do
    {
#        print STDERR "src #$srclinect==$srcline";
        chomp;
        $srcline = $_;
        if ( /(.*[^ ]) *\/\// )  { $srcline = $1; } # remove trailing comments
        if ( $srcline =~ /.*\) *$/ )
        {
#            print STDERR "XXX $srcline;$declcomment\n";
            print "$srcline;$declcomment\n";
            goto printcomment;
        }
        else
        {
#            print STDERR "YYY $srcline\n";
            print "$srcline\n";
        }
    }
    while ( <SRCFILE> );        # read until everything useful printed

  printcomment:
    if ( $commentsq )           # comments before function body
    {
        while ( <SRCFILE> )
        {
            $DEBUG && print STDERR "# $hlinect: (echofunc.printcomment)\n";
            if ( /^\{/ )      { goto dort; } # start of definition
            if ( /^\/\/\./ )  { goto dort; } # "//." stops output
            if ( !/[\w]/ )    { next; } # nothing to print
#            print STDERR "YYY $srcline\n";
            print "$_";
        }
    }

  dort:
#    print STDERR "  DORT\n";

    print "\n";

    print STDERR "   $rettype $funcnm()\n";
}
####################################################