#!/usr/local/bin/perl

#
#     NAME: stubgen
#   AUTHOR: Michael J. Radwin <mjr@acm.org>
# MODIFIED: $Id: stubgen.pl,v 1.11 1998/05/15 22:10:27 mradwin Exp $
#
# DESCRIPTION
#      stubgen takes a C++ header (.H or  .h)  file,  finds  member
#      function  prototypes,  and  expands  those  prototypes  into
#      member function definiton stubs to a code (.C or  .cc)  file
#      of the same name.
# 
#      Code files, if they exist, are scanned for member functions.
#      If any function prototype in the header file has a signature
#      that does not match the signatures of functions in the  code
#      file,  stubgen  will expand that prototype.  stubgen appends
#      to whatever code file you have around, so it won't  acciden-
#      tally clobber your existing code files.
# 
# reminder to myself: never hack something as bad as this ever again.
# It may work, but it sure is getting ugly.
#
# doc: http://www.radwin.org/michael/projects/stubgen/

#-----------------------------------------------------------------------#
# usage and command-line options
#-----------------------------------------------------------------------#
require 'getopts.pl';
require 'ctime.pl';

$usage = 'usage: stubgen [-hqlxricdvVfsjpn] infiles
  GENERAL OPTIONS
    -h        Display usage information.
    -q        Quiet mode, no status information while generating code.
    -l        Generate source files with a lowercase (.cc) extension.
    -x        Generate source files with a .cxx extension.
    -r        Make RCS-style file headers
    -i        Don\'t put the #include "my_file.H" directive in my_file.C

  DEBUGGING OUTPUT OPTIONS (prints "class::function" in body of function)
    -c        Use cerrs and iostream.h
    -d        Use cs169-style dprintf\'s and Debug.H

  METHOD HEADER STYLES
    -v        Verbose method headers, similar style to the cs032
              method headers you get from the emacs mode.  (default)
    -V        Really verbose method headers, true cs032 style because
              each line both begins and ends the comment.  Code by dp.
    -f        Full method headers, a cross between -p and -v.
    -s        Simple method headers.
    -j        Java-style method headers.
    -p        Plain headers, just the name of the function.
    -n        No method headers.';

# get the command-line options and die if there is a bad option or
# there are no filenames
&Getopts('hqlxricdvVfsjpn') || die "$usage\n";
$opt_h && die "$usage\n";
$ARGV[0] || die "$usage\n";

# use verbose comment style if no style specified on the command line
$opt_v = 1 if !($opt_v || $opt_V || $opt_f || 
		$opt_s || $opt_j || $opt_p || $opt_n);

# -d takes precedence over -c if they're both on the command line
$opt_c = 0 if ($opt_c && $opt_d);


#-----------------------------------------------------------------------#
# main
#-----------------------------------------------------------------------#
foreach $inFile (@ARGV) {
    open(INFILE, $inFile) || die "Can't read $inFile\: $!\n";

#    if (!($inFile =~ /\.[hH]$/)) {
#	print STDERR "$inFile skipped - not a .h or .H file\n";
#	next;
#    }

    # get rid of all of the pathnames so we write the .C file to the
    # current directory -- clobbers everything to the left of the
    # rightmost slash
    $inFile =~ s,.*/([^/]+),$1, if $inFile =~ m,/,;
    $outFile = $inFile;
    $outFile =~ s/\.H$//;
    $outFile =~ s/\.h$//;

    # set opt_l according to existence of .cc or .C file for users who
    # forget.  If both exist, .cc takes precedence over .C
    $opt_l = 0 if -e "$outFile.C";
    $opt_x = 0 if -e "$outFile.C";
    $opt_l = 1 if -e "$outFile.cc";
    $opt_x = 1 if -e "$outFile.cxx";
    $outFile .= ($opt_x) ? '.cxx' : ($opt_l) ? '.cc' : '.C';

    # minor hack to avoid making a .C file if no functions are found
    $fileOpened = 0;

    # compute function signatures in case we need 'em
    $fileExisted = -e $outFile;
    %sigs = &previous_sigs;

    # ignore comments and blank space till we get to a a class
    while(<INFILE>) {
	next if /^\s*class\s+\w+\s*;/;   # fwd declared classes
	
	if (/^\s*class\s+(\w+)\b.*\{/) {
	    $class = $1;
	    &doClass;

	} elsif (/^\s*class\s+(\w+)\b/) {
	    $class = $1;
	    &inform_user("$class might be a class, looking for open brace\n");
	    while(<INFILE>) {
		&doClass if /\{/;
	    }
	}
    }
}

exit(0);


#-----------------------------------------------------------------------#
# sub doClass
#
# processes an entire class.  returns when the end of the current
# class has been reached.
#-----------------------------------------------------------------------#
sub doClass {
    &inform_user("==> class $class ($inFile)\n");
    $new_functions = 0;

    while(<INFILE>) {
	# get rid of comments so we can better recognize lines
	s,\s*//.*$,,;
	s,\s*/\*.*\*/,,;

	last if /^\s*\}\s*;\s*$/; # end of class declaration

	# nested classes!  ack!  ignore by chewing the lines
	if (/\bclass\b[^\{]*\{/ || /\bstruct\b[^\{]*\{/ || 
	    /\bunion\b[^\{]*\{/ || /\benum\b[^\{]*\{/) {
	    &inform_user("----> nest found, looking for close brace\n");
	    do {
		&inform_user("        $_");
	    } until /\s*\}\s*;\s*/ || !($_ = <INFILE>);
	    &inform_user("----> nest finshed\n");
	}
	
	# lines to ignore -- these clearly aren't functions that
	# should be expanded
	next if /^\s*friend/;	# skip those friends
	next if /=\s*0;\s*$/;	# skip pure virtuals
	next if m,^\s*//,;	# skip comment lines (begin with a //)
	next if /\{.*;\s*\}\s*;?\s*$/; # skip inline functions with code
	next if /\{\s*}\s*;?\s*$/; # skip inline functions w/o code

        # tokens to get rid of -- they may be on lines by themselves,
        # but they also may be on lines with functions.  Whatever the
        # case, we can safely ignore them.
	s/\s*\bprotected\s*:\s*//;
        s/\s*\bprivate\s*:\s*//;
	s/\s*\bpublic\s*:\s*//;
	s/\s*\bvirtual\b//;
	s/\s*\bstatic\b//;

        # ignore any blank lines that are either whitespace or were
        # produced by clobbering the above tokens.
	next if /^\s*$/;

#--------------------------
# member function rules
#--------------------------

	# pick up constructors and destructors (this actually lets the
	# user have a destructor that takes parameters, but hey -- if
	# they're stupid enough to do it, I may as well expand the
	# function to the .C file :-)
	if (/^\s*(~?)$class\s*\((.*)\)(.*);/) { 
	    &printFunction($class, '', $1 . $class, $2, $3);
	}

	# pick up operator-overloaded functions
	elsif (/^\s*(.*)(\boperator.*)\s*\((.*)\)(.*);/) { 
	    &printFunction($class, $1, $2, $3, $4);
	}

        # pick up normal functions here (newest version).  Works very
        # well with references, pointers and embedded const.  Also
        # manages to pick up templated return types.
        #
        # the important facet of this rule to work is the first
        # parenthesized expression.  It matches alphanumerics, spaces,
        # * and &'s, and template elements (<>,).  Before the function
        # name, it must match at least one space, pointer or
        # reference.
        elsif (/^\s*([\w\s\*&<>,]+)([\s\*\&]+)(\w+)\s*\((.*)\)(.*);/) {
	    &printFunction($class, $1 . $2, $3, $4, $5);
	}
	
        # try and pick up normal functions that have multi-line parameter
        # lists.  Not finished with this yet
        elsif (/^\s*([\w\s\*&<>,]+)([\s\*\&]+)(\w+)\s*\(([^\)]+)/) {
	    $ret = $1 . $2;
	    $func = $3;
	    $param = $4;
	    chop $param;

	    while(<INFILE>) {
		if (/^\s*([^\)]+)\)(.*);/) {
		    $param .= ' ' . $1;
		    $const = $5;
		    last;

		} else {
		    $tmp = $_;
		    $tmp =~ s/^\s*(\b.+)\s*$/$1/;
		    $param .= ' ' . $tmp;
		}
	    }

	    &printFunction($class, $ret, $func, $param, $const);
	}
    }
    
    &inform_user("==> class $class (" . $new_functions . " function");
    &inform_user(($new_functions == 1) ? " " : "s ");
    &inform_user("appended to $outFile)\n");
}


#-----------------------------------------------------------------------#
# sub printFunction
#
# expands a member function to the .C file
#-----------------------------------------------------------------------#
sub printFunction {
    local($class, $ret_type, $func, $param, $const) = @_;
    local($fsig);

    # if we've already matched this signature, don't even bother
    $fsig = &signature($class, $ret_type, $func, $param, $const);
    return if $sigs{$fsig};

    $new_functions++;
    if (!$fileOpened) {
	$fileOpened = 1;
	open(OUTFILE, ">>$outFile") || die "Can't write to $outFile\: $!\n";
	&fileHeader unless $fileExisted;
    }

    # let the user know that this method will be written to the .C file
    &inform_user("      $func\n");

    # do the header in the style they like
    $ret_type =~ s/\s*$//;
    &functionHeader;

    # remove default values from parameters if they exist
    $param =~ s/\s*=[^,\)]+\s*//g;

    print OUTFILE $ret_type, "\n";
    print OUTFILE $class, '::', $func, '(', $param, ')', $const, "\n";
    print OUTFILE "{\n";

    $opt_c && print OUTFILE "    cerr << \"", $class, '::', $func, "\" << endl;\n";
    $opt_d && print OUTFILE "    dprintf((\"", $class, '::', $func, "\\n\"));\n";

    print OUTFILE "}\n\n\n";
}


#-----------------------------------------------------------------------#
# sub functionHeader
#
# prints a header if one is neccesary based on commandline switches
#-----------------------------------------------------------------------#
sub functionHeader {
    # cs032 style comment
    if ($opt_v) {
	print OUTFILE "/*************************************************************************\n";
	print OUTFILE " * Function Name: ", $class, '::', $func, "\n";
	print OUTFILE " * Parameters: $param\n";
	print OUTFILE " * Returns: $ret_type\n" if $ret_type ne '';
	print OUTFILE " * Effects: \n";
	print OUTFILE " *************************************************************************/\n";
    }

    # dp style comment -- this code courtesy Dan Price
    elsif ($opt_V) {
	$headerLine = '/' . '*' x 73 . "/\n";
	print OUTFILE $headerLine;

	$temp = '/* Function Name: ' . $class . '::' . $func;
	
	#pad the correct num spaces.
	$numSpaces = ((length $headerLine) - (length $temp)) - 3;
	#the -3 is voodoo.

	print OUTFILE $temp;
	print OUTFILE ' ' x $numSpaces;
     	print OUTFILE "*/\n";

	$temp = '/* Parameters: ' . $param;
	$numSpaces = ((length $headerLine) - (length $temp)) - 3;

	print OUTFILE $temp;
	print OUTFILE ' ' x $numSpaces;
     	print OUTFILE "*/\n";

	$temp = '/* Returns: ' . $ret_type;
	$numSpaces = ((length $headerLine) - (length $temp)) - 3;
	print OUTFILE $temp, ' ' x $numSpaces, "*/\n" if $ret_type ne '';

	$temp = '/* Effects: ';
	$numSpaces = ((length $headerLine) - (length $temp)) - 3;

	print OUTFILE $temp;
	print OUTFILE ' ' x $numSpaces;
     	print OUTFILE "*/\n";
    
	print OUTFILE $headerLine;
    }

    # full method headers
    elsif ($opt_f) {
	print OUTFILE "/*\n";
	print OUTFILE " * Function Name: ", $class, '::', $func, "\n";
	print OUTFILE " * Parameters: $param\n";
	print OUTFILE " * Returns: $ret_type\n" if $ret_type ne '';
	print OUTFILE " * Effects: \n";
	print OUTFILE " */\n";
    }

    # simple style comment
    elsif ($opt_s) {
	print OUTFILE "/*************************************************************************\n";
	print OUTFILE " * ", $class, '::', $func, "\n";
	print OUTFILE " * \n * \n";
	print OUTFILE " *************************************************************************/\n";
    }

    # java-style comment
    elsif ($opt_j) {
	print OUTFILE "/**\n";
	print OUTFILE " * ", $class, '::', $func, "\n";
	print OUTFILE " * \n * \n";
	print OUTFILE " */\n";
    }

    # plain comment
    elsif ($opt_p) {
	print OUTFILE "/*\n";
	print OUTFILE " * ", $class, '::', $func, "\n";
	print OUTFILE " */\n";
    }
}

#-----------------------------------------------------------------------#
# sub fileHeader
#
# prints a header for our file with creator, file, date info
#-----------------------------------------------------------------------#
sub fileHeader {
    local($date) = &ctime(time);
    local($rcs_hdr, $cs032_hdr, $domain);
    chop($date);
    
    # we'll need to do a lookup in the password file in case the
    # environment variable is not set.
    $ENV{'USER'} = getlogin || (getpwuid($<))[0] || 'nobody' 
	unless defined($ENV{'USER'}) && $ENV{'USER'} ne '';
    $ENV{'NAME'} = (split(/,/, (getpwnam($ENV{'USER'}))[6]))[0]
	unless defined($ENV{'NAME'}) && $ENV{'NAME'} ne '';
    $domain = (defined($ENV{'STUBGEN_DOM'}) && $ENV{'STUBGEN_DOM'} ne '')
	? '@' . $ENV{'STUBGEN_DOM'} : '';

    $rcs_hdr = "/*
 *  FILE: $outFile
 *  AUTH: $ENV{'NAME'} <$ENV{'USER'}$domain>
 *
 *  DESC: 
 *
 *  DATE: $date
 *  \$Id\$ 
 *
 *  Modification history: 
 *  \$Log\$ 
 *
 */
";

    $cs032_hdr = "/*************************************************************************
 *    NAME: $ENV{'NAME'}
 *    USER: $ENV{'USER'}$domain
 *    FILE: $outFile
 *    DATE: $date
 *************************************************************************/
";

    $opt_r && print OUTFILE $rcs_hdr;
    $opt_r || print OUTFILE $cs032_hdr;
    $opt_i || print OUTFILE "#include \"$inFile\"\n";
    $opt_c && print OUTFILE "#include <iostream.h>\n";
    $opt_d && print OUTFILE "#include <Debug.H>\n";
    print OUTFILE "\n";
}


#-----------------------------------------------------------------------#
# sub signature
#
# given a function prototype, returns the stubgen "signature" of it,
# which we'll hash for the comparison function
#-----------------------------------------------------------------------#
sub signature {
    local($class, $ret_type, $func, $param, $const) = @_;

    # remove default values from parameters if they exist
    $param =~ s/\s*=[^,\)]+\s*//g;

    # remove whitespace from all variables
    $ret_type =~ s/\s//g;
    $func =~ s/\s//g;
    $const =~ s/\s//g;

    $param =~ s/\w+,/,/g;
    $param =~ s/\w+\[\],/,/g;  # for things like char a[], int b
    $param =~ s/\w+$//;
    $param =~ s/\w+\[\]$//;  # for things like char a[], int b
    $param =~ s/\s//g;
    
    return $ret_type . $class . $func . '(' . $param . ')' . $const;
}

    
#-----------------------------------------------------------------------#
# sub previous_sigs
#
# returns an associative array of function signatures that
# were found in the file named by $outFile, also uses $fileExisted
#-----------------------------------------------------------------------#
sub previous_sigs {
    local(%fsigs);
    local(*CODEFILE);
    local($prevline);

    return %fsigs unless $fileExisted;

    open(CODEFILE, $outFile) || die "Can't read $outFile\: $!\n";
    $prevline = '';
    while(<CODEFILE>) {
	chop;
	if (/^\s*(\w+)\:\:(operator\b.*)\s*\(([^\)]*)\)(.*)/) {
	    $fsigs{&signature($1, $prevline, $2, $3, $4)} = 1;
	} elsif (/^\s*(\w+)\:\:([^\(]+)\(([^\)]*)\)(.*)/) {
	    $fsigs{&signature($1, $prevline, $2, $3, $4)} = 1;
	}
	$prevline = $_;
    }
    close(CODEFILE);

    return %fsigs;
}

#-----------------------------------------------------------------------#
# sub inform_user
#
# prints out the string to STDOUT unless the quiet option is selected
#-----------------------------------------------------------------------#
sub inform_user {
    $opt_q || print STDOUT $_[0];
}