#!/usr/bin/perl

# Take a C library, and turn it into something else:
# $1 -> output style: c++, idl, cmd

use strict;
my($incomment, $origline, $code, $possfunction, $arg, %pointers, $class,
   %creates, %parents, %suppress, %fsuppress, $temp, $methodid, $SUBST, $DOCO);

$incomment = 0;
$code = "";

if($ARGV[0] eq "idl"){
print "// This code was automatically generated by objectify, which is\n";
print "// available from http://www.stillhq.com -- edit this file at your\n";
print "// own risk\n\n";
print "import \"oaidl.idl\";\n";
print import \"ocidl.idl\";\n\n";
}
elsif($ARGV[0] eq "c++"){
print "// This code was automatically generated by objectify, which is\n";
print "// available from http://www.stillhq.com -- edit this file at your\n";
print "// own risk\n\n";
}
elsif($ARGV[0] eq "cmd"){
print "#!/bin/bash\n\n";
print "# This simple shell script is used to generate the command line interface.\n";
print "# It was automatically generated by objectify, which is available from\n";
print "# http://www.stillhq.com -- edit this file at your own risk\n";
print "#\n";
print "# $* is a list of the files to be processed (all end in .template)\n";
print "set -x\n\n";
print "echo \"\" > /tmp/\$\$-objectify_tokens\n";
print "echo \"\" > /tmp/\$\$-objectify_tokenlexs\n";
print "echo \"\" > /tmp/\$\$-objectify_grammar\n\n";
print "echo \"\" > /tmp/\$\$-objectify_documentation\n\n";
}
else{
  print STDERR "Usage: objectify [c++ | idl | cmd] < input > output\n";
  exit;
}

# Prepare the input
while(<STDIN>){
  if((!/^\#define/) && (/SUPPRESS[ \t]*\(([^ \t]*)\)/)){
    if($ARGV[0] eq "c++"){
      print "// $1 class suppressed\n";
    }
    elsif($ARGV[0] eq "idl"){
      print "// $1 class suppressed\n";
    }
    elsif($ARGV[0] eq "cmd"){
      print "# $1 class suppressed\n";
    }
    $suppress{$1} = "yes";
  }
  if((!/^\#define/) && (/SUPPRESS[ \t]*\((.*),[ \t]*(.*)\)/)){
    if($ARGV[0] eq $2){
      if($ARGV[0] eq "c++"){
	print "// $1 class suppressed\n";
      }
      elsif($ARGV[0] eq "idl"){
	print "// $1 class suppressed\n";
      }
      elsif($ARGV[0] eq "cmd"){
	print "# $1 class suppressed\n";
      }
      $suppress{$1} = "yes";
    }
  }
  if((!/^\#define/) && (/SUPPRESSEX[ \t]*\((.*), (.*)\)/)){
    if($2 eq $ARGV[0]){
      if($ARGV[0] eq "c++"){
	print "// $1 function suppressed\n";
      }
      elsif($ARGV[0] eq "idl"){
	print "// $1 function suppressed\n";
      }
      elsif($ARGV[0] eq "cmd"){
	print "# $1 function suppressed\n";
      }
      $fsuppress{$1} = "yes";
    }
  }

  # Remove comments from the line
  s/\/\/.*$//;
  s/\/\*.*\*\///;
  s/\r//g;
  s/^[ \t]+//;
  $origline = $_;
  s/\/\*.*$//;
  s/^.*\*\///;

  # We want the newlines to stay for cpp directives
  if(!/\#/){
    chomp;
  }

  if($incomment == 0){
    $code = "$code$_";
  }

  $_ = $origline;
  # Block comment closed?
  if(/.*\*\//){
    $incomment = 0;
  }

  # Comments which dangle over to the next line
  if(/\/\*.*/){
    $incomment = 1;
  }
}

$code =~ s/[ \t]+/ /g;

# We now go through each line in the code, looking for functions...
foreach $possfunction (split(/;/, $code)){
  $_ = $possfunction;
  my($processed, $rval, $fval, $aval, $bestarg);

  $processed = 0;
  if(!(/INTERNAL/) && 
     (/([a-zA-Z0-9_\*]+) ([a-zA-Z0-9_\*]+) \(([^\(\)]*)\)/)){
    ($rval, $fval, $aval) = ($1, $2, $3);
    $_ = $aval;
    $bestarg = "";
    s/ //g;
    foreach $arg (split(/,/)){
      # The arg might have a name attached to it, we split this off
      $arg =~ s/ [^ ]*$//;

      # If the last character is a * then this is a pointer
      # ignore some boring pointers which are too common
      $_ = $arg;
      if(($arg ne "char*") && ($arg ne "int*") && ($arg ne "void*") && 
	 (/\*$/)){
	$arg =~ s/\*$//;
	$bestarg = $arg;
	$processed = 1;
      }
    }

    if($bestarg ne ""){
      $pointers{$bestarg} = $pointers{$bestarg}."$rval!$fval!$aval;";
    }

    # If there is a * in the combination of the return value and the 
    # function name, then this is a creation function
    $_ = "$rval$fval";
    if(($rval ne "char") && ($rval ne "void") && ($rval ne "int") &&
       (/.*\*.*/)){
      $creates{$rval} = $creates{$rval}."$fval;";
    }
  }
  else{
    $processed = 1;
  }

  if($processed == 0){
    # I am not sure this ever gets called
    my($libname);
    $libname = $fval;
    $libname =~ s/_.*$//;
    $libname =~ s/\*//;
    $pointers{$libname} = $pointers{$libname}."$rval!$fval!$aval;";
  }
}

# Determine the parent relationships between classes
foreach $class (keys %pointers){
  if($suppress{$class} eq ""){
    # We need to output all the functions which use one of these pointers
    my($rval, $fval, $aval, @argsarray);
    @argsarray = split(/;/, $pointers{$class});

    while($argsarray[0] ne ""){
      ($rval, $fval, $aval) = split(/!/, shift @argsarray);
      $aval =~ s/$class[ \t\*]+[, ]*//;
      $fval =~ s/\*//;

      # We only support one parent at the moment
      if(($parents{$rval} eq "") && ($suppress{$rval} eq "")){
	$parents{$rval} = $parents{$rval}."$class";
      }
    }
  }
}

# We need forward declarations -- we just do it for all classes
if($ARGV[0] eq "c++"){
  foreach $class (keys %pointers){
    if($suppress{$class} eq ""){
      print "class C$class;\n";
    }
  }
  print "\n";
}

# We now know the commonly passed pointers
foreach $class (keys %pointers){
  $methodid = 1;
  if($suppress{$class} eq ""){
    if($ARGV[0] eq "c++"){
      print "class C$class\n{
public:\n";

      if($creates{$class} ne ""){
	# The constructor needs to take the parent
	print "  C$class($class *passed_ptr";
	if(($parents{$class} ne "") && 
	   ($creates{$parents{$class}} ne "")){
	  print ", $parents{$class}* passed_$parents{$class}) :
    m_$parents{$class}(passed_$parents{$class})
    { m_ptr = passed_ptr; }\n";
	}
	else{
	  print ")
    { m_ptr = passed_ptr; }\n";
	}
	
	print "  ~C$class() { panda_xfree(m_ptr); }\n\n";
      }
    }
    elsif($ARGV[0] eq "idl"){
      print "[\n";
      print "object,\n";
      print "uuid(INSERTUUID),\n";
      print "dual,\n";
      print "pointer_default(unique)\n";
      print "]\n";
      print "interface I$class : IDispatch\n";
      print "{\n";
    }

    # We need to output all the functions which use one of these pointers
    my($rval, $fval, $fupval, $aval, $origargs, @argsarray);
    @argsarray = split(/;/, $pointers{$class});

    print "\n";
    while($argsarray[0] ne ""){
      ($rval, $fval, $aval) = split(/!/, shift @argsarray);
      $origargs = $aval;

      $fval =~ s/^\*//;
      if($fsuppress{$fval} eq ""){
	if($ARGV[0] eq "cmd"){
	  $fupval = uc($fval);

	  print "\n";
	  print "echo \"\%token <textVal> $fupval\" >> /tmp/\$\$-objectify_tokens\n";
	  print "printf \"\%-30s { return \%-30s; }\\n\" $fval $fupval ";
	  print   ">> /tmp/\$\$-objectify_tokenlexs\n";
	  print "echo -n \"$fval: $fupval \" >> /tmp/\$\$-objectify_grammar\n";
	  print "echo -n \"$fval commands | \" >> /tmp/\$\$-objectify_commands\n";

	  # Also extract the synopsis from the generated documentation and put it
	  # somewhere safe
	  print "echo \"Function: $fval\" >> /tmp/\$\$-objectify_documentation\n";
	  open DOCO, "< man/$fval.sgml";
	  while(<DOCO>){
	    if(/<refpurpose>(.*)<\/refpurpose>/){
	      print "echo \"Purpose: $1\" >> /tmp/\$\$-objectify_documentation\n";
	    }
	  }
	  close DOCO;
	}
	
	# Do we have a child relationship because of this function?
	$aval =~ s/$class[ \t\*]+[, ]*//;
	if($parents{$class} ne ""){
	  $temp = $parents{$class};
	  $aval =~ s/$temp[ \t\*]+[, ]*//;
	}
	
	$_ = $fval;
	s/[^_*]*_//;
	if($ARGV[0] eq "c++"){
	  # Sometimes instead of returning a straight pointer, 
	  # we will want to return a class
	  if($pointers{$rval} ne ""){
	    s/\*//;
	    print "  C$rval $_ (";
	  }
	  else{
	    print "  $rval $_ (";
	  }
	}
	elsif($ARGV[0] eq "idl"){
	  print "  [id($methodid)] HRESULT $_(";
	  $methodid++;
	}
	
	my($argcount);
	if($ARGV[0] eq "cmd"){
	  $argcount = 2;
	}
	else{
	  $argcount = 0;
	  }

	foreach $temp (split/,/, $aval){
	  $temp =~ s/^ //;
	  if($ARGV[0] eq "c++"){
	    if($argcount > 0){
	      print ", ";
	    }
	    print "$temp a$argcount";
	  }
	  elsif($ARGV[0] eq "idl"){
	    if($argcount > 0){
	      print ", ";
	    }
	    print "[in] $temp a$argcount";
	  }
	  elsif($ARGV[0] eq "cmd"){
	    my($argtype);
	    if($temp eq "int"){
	      $argtype = "INTEGER";
	    }
	    elsif($temp eq "char *"){
	      $argtype = "QUOTESTR";
	    }
	    elsif($temp eq "double"){
	      $argtype = "FLOAT";
	    }
	    else{
	      $argtype = "UNKNOWN($temp)";
	    }

	    print "echo -n \"$argtype \" >> /tmp/\$\$-objectify_grammar\n";
	    print "echo \"Arguement: $argtype\" >> /tmp/\$\$-objectify_documentation\n";
	  }

	  # Feed in the passed args
	  $origargs =~ s/ *$temp *\**/ a$argcount/;
	  $argcount++;
	}
	
	if($ARGV[0] eq "c++"){
	  print ") {";

	  # Subst our class's pointer
	  $origargs =~ s/$class *\*/m_ptr/g;

	  # How about a parent pointer?
	  if($parents{$class} ne ""){
	    $origargs =~ s/$parents{$class} \*/$parents{$class}/;
	    $origargs =~ s/$parents{$class}/m_$parents{$class}/;
	  }

	  $fval =~ s/^\*//;
	  if($rval ne "void"){
	    print " return";
	  }

	  # If we are building a class, then do it here
	  if($pointers{$rval} ne ""){
	    print " C$rval($fval($origargs)";
	    if($creates{$class} ne ""){
	      print ", m_ptr";
	    }
	    print "); ";
	  }
	  else{
	    print " $fval($origargs); ";
	  }
	  print "}\n";
	}
	elsif($ARGV[0] eq "idl"){
	  print ");\n";
	}
	elsif($ARGV[0] eq "cmd"){
	  print "echo \"\" >> /tmp/\$\$-objectify_grammar\n";
	  print "echo \"{\" >> /tmp/\$\$-objectify_grammar\n";

	  # Subst our class's pointer
	  print "echo \"\t// Class pointer is $class\" >> /tmp/\$\$-objectify_grammar\n";
	  $origargs =~ s/$class *\*/m_$class/g;

	  # How about a parent pointer?
	  if($parents{$class} ne ""){
	    print "echo \"\t// Parent pointer is ".$parents{$class}.
	      "\" >> /tmp/\$\$-objectify_grammar\n";
	    $origargs =~ s/$parents{$class} \*/m_$parents{$class}/;
	  }

	  $fval =~ s/^\*//;
	  print "echo -n \"\t\" >> /tmp/\$\$-objectify_grammar\n";
	  if($rval ne "void"){
	    print "echo -n \"m_$rval = \" >> /tmp/\$\$-objectify_grammar\n";
	  }

	  $temp = $origargs;
	  $temp =~ s/ a/ \\\$/g;
	  print "echo \"$fval($temp);\" >> /tmp/\$\$-objectify_grammar\n";
	  print "echo \"\tprintf(\\\"100 $fval executed\\n\\\");\" >> /tmp/\$\$-objectify_grammar\n";

	  print "echo \"}\" >> /tmp/\$\$-objectify_grammar\n";
	  print "echo \"\" >> /tmp/\$\$-objectify_grammar\n";
	}
      }
    }

    if($ARGV[0] eq "c++"){
      if($creates{$class} ne ""){
	print "\n";
	print "private:\n";
	print "  $class *m_ptr;\n";
      }

      if(($parents{$class} ne "") && ($creates{$parents{$class}} ne "")){
	  print "  $parents{$class} *m_$parents{$class};\n";
	}

      print "};\n\n";
    }
    elsif($ARGV[0] eq "idl"){
      print "};\n\n";
    }
  }
}

if($ARGV[0] eq "idl"){
  print "[\n";
  print "uuid(INSERTUUID),\n";
  print "version(1.0),\n";
  print "]\n";
  print "library OBJECTIFYLib\n";
  print "{\n";
  print "    importlib(\"stdole32.tlb\");\n";
  print "    importlib(\"stdole2.tlb\");\n";
  print "\n";
  print "    [\n";
  print "    uuid(INSERTUUID),\n";
  print "    ]\n";
  print "    coclass Cfoo\n";
  print "    {\n";
  print "	[default] interface Ifoo,\n";
  print "    };\n";
  print "};\n\n";
}

if($ARGV[0] eq "c++"){
  print "\n\n// End of file\n";
}
elsif($ARGV[0] eq "idl"){
  print "\n\n// End of file\n";
}
elsif($ARGV[0] eq "cmd"){
  print "\n";
  print "# Setup the command globals\n";
  foreach $temp (keys(%creates)){
    if($temp ne ""){
      print "echo \"  $temp *m_$temp;\" >> /tmp/\$\$-objectify_pointers\n";
    }
  }
  print "\n";

  print "# We also need the subst command to be sitting around ready to be used...\n\n";
  open SUBST, "< subst" or die "Could not open subst: $!";
  print "rm -f /tmp/\$\$-SuBsT\n";
  while(<SUBST>){
    chomp;
    chomp;
    s/\$/\\\$/g;
    s/`/\\`/g;
    s/"/\\"/g;
    print "echo \"$_\" >> /tmp/\$\$-SuBsT\n";
  }
  close SUBST;

  print "chmod 711 /tmp/\$\$-SuBsT\n";
  print "\n";
  print "for file in \$*\n";
  print "do\n";
  print "  outfile=`echo \$file | sed 's/.template\$//'`\n";
  print "  echo \"\$file -> \$outfile\"\n";
  print "  /tmp/\$\$-SuBsT /tmp/\$\$ < \$file > \$outfile\n";
  print "done\n";
  print "\n";

  print "# Generate the SGML documentation\n";
  print "# ...TODO...\n\n";

  print "# End of file\n";
}

exit;