#!/usr/bin/perl
#
# credo.pl - Create Doxygen comments for C++ header file
#
# Usage:     perl credo.pl [-d] HEADERFILE
#
# Output goes to stdout.
# The script parses HEADERFILE for function declarations and
# creates a Doxygen formatted comment before each funtcion.
# The Doxygen comment contains the function name, return type,
# argument names(s) and argument type(s).
# This eases the work for fleshing out the documentation.
# The option "-d" switches on verbose messages on program execution
# for debugging purposes.
#
# Version:   2016-06-30
#
# Copyright (C) 2016, Oliver Kellogg  <okellogg@users.sourceforge.net>
#
# -------------------------------------------------------------------------
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# -------------------------------------------------------------------------

use strict;

@ARGV or die "supply C++ header file\n";

my $debug = 0;
if ($ARGV[0] eq "-d") {
  $debug =1;
  shift @ARGV;
}
my $fname = $ARGV[0];
open(IN, "<$fname") or die "Canot open file $fname\n";

my $in_comment = 0;
my $rettype = "";
my $funcname = "";
my $in_func = 0;  # contains the line number of the function declaration when in use (0 means "not in use")
my $in_body = 0;
my @args = ();
my @outbuf = ();
my $linenum = 0;
my $line;

sub debug {
  if ($debug) {
    print "\t\t\t\t// ";
    print(@_);
    print "\n";
  }
}

sub map_undef_to_0 {
  my $item = shift;
  return $item ? $item : 0;
}

sub print_func {
  my @doxy_comment =   "\t/**";
  push @doxy_comment,  "\t * \@function $funcname";
  my $max_namelen = 0;
  # Find the maximum parameter name length:
  foreach (@args) {
    my $name = $_->[1];
    if (length($name) > $max_namelen) {
      $max_namelen = length($name);
    }
  }
  # Pretty print the function arguments:
  foreach (@args) {
    my $type = $_->[0];
    my $name = $_->[1];
    my $whitespace = ' ' x ($max_namelen - length($name) + 1);
    push @doxy_comment, "\t *   \@param $name $whitespace \@type $type";
  }
  $rettype =~ s/\s+$//;
  if ($rettype && $rettype ne "void") {
    push @doxy_comment,  "\t * \@return $rettype";
  }
  push @doxy_comment,   "\t */";
  splice @outbuf, $in_func - 1, 0, @doxy_comment;
  $in_func = 0;
  @args = ();
  $rettype = "";
  $funcname = "";
}

sub parse_args {
  my($type, $name) = @_;
  push @args, [ $type, $name ];
  # remove the parameter parsed
  $line =~ s/^[^,\)]+//;
  while ($line =~ /^,\s*(const +)?([\w:]+\W+)+?([\w:]+)/) {
    $type = "$1$2";
    push @args, [ $type, $3 ];
    # remove the parameter parsed
    $line =~ s/^,[^,\)]+//;
  }
  if ($line =~ /\)/) {
    unless ($line =~ /^\s*\)/) {
      warn "Unconsumed items at line $. : $line\n";
    }
    print_func;
    my @open_brace = $line =~ /\{/g;
    if (@open_brace) {
      my @close_brace = $line =~ /\}/g;
      $in_body = scalar(@open_brace) - scalar(@close_brace);
      if ($in_body < 0) {
        warn "in_body: More closing braces than opening braces (?)\n";
        $in_body = 0;
      }
    }
  } else {
    $in_func = $linenum;
  }
}

my $expecting_openbrace = 0;

while (<IN>) {
  chop;
  $line = $_;
  push @outbuf, $line;
  $linenum = $.;
  $line =~ s@\s*//.*$@@;
  if ($line =~ /\/\*/) {
    if ($line =~ /\*\//) {
      $line =~ s@/\*.*?\*/@@;
    } else {
      $in_comment = 1;
      next;
    }
  } elsif ($line =~ /\*\//) {
    $in_comment = 0;
    next;
  } elsif ($in_comment) {
    next;
  }
  next if ($line =~ /^\s*$/);    # empty line (after removal of possible comment)
  next if ($line =~ /^\s*\#/);   # preprocessor directive
  $line =~ s/^\s+//;
  if ($in_body) {
    my @open_brace = $line =~ /\{/g;
    my @close_brace = $line =~ /\}/g;
    $in_body += scalar(@open_brace) - scalar(@close_brace);
    debug "IN_BODY(1) delta=$in_body  $line";
    if ($in_body < 0) {
      warn "main in_body: More closing braces than opening braces (?)\n";
      $in_body = 0;
    }
  } elsif ($line =~ /^(namespace|class|struct)\s+(\w+)/) {
    my($keyword, $name) = ($1, $2);
    $expecting_openbrace = map_undef_to_0($line !~ /[\{;]/);
    debug "$keyword $name : expecting_openbrace=$expecting_openbrace";
  } elsif ($line =~ /^(explicit +|static +|const +|volatile +)*([\w:]+\W+)(\w+)\s*\(/) {
    $rettype = "$1$2";
    $funcname = $3;
    $line =~ s/^.+\(\s*//;
    debug "main - function: $funcname return $rettype ; line is $line";
    if (!$line) {
      $in_func = $linenum;
    } elsif ($line =~ /^(const +)?([\w:]+\W+)+?([\w:]+)/) {
      debug "main - function: type $2, name $3";
      parse_args("$1$2", $3);
    } else {
      unless ($line =~ /^void/) {
        warn "$funcname: Unrecognized end of line $. : $line\n";
      }
      print_func;
    }
  } elsif ($in_func) {
    debug "main in_func $funcname : $line\n";
    if ($line =~ /^(const +)?([\w:]+\W+)+?([\w:]+)/) {
      parse_args("$1$2", $3);
    } else {
      warn "in_func: Unrecognized line $. : $line\n";
      if ($line =~ /\)/) {
        print_func;
      }
    }
  } elsif ($line =~ /\{/) {
    if ($expecting_openbrace) {
      $expecting_openbrace = 0;
    } else {
      my @open_brace = $line =~ /\{/g;
      my @close_brace = $line =~ /\}/g;
      $in_body = scalar(@open_brace) - scalar(@close_brace);
      debug "IN_BODY(2) delta=$in_body  $line";
      if ($in_body < 0) {
        warn "main in_body(2): More closing braces than opening braces (?)\n";
        $in_body = 0;
      }
    }
  }
}

close IN;

foreach (@outbuf) {
  print "$_\n";
}

print "// The End.\n";

1;