#!/usr/local/bin/perl -w

# rcpp2html -c "Resolve/C++ Catalog" -d RC /class/sce/rcpp/RESOLVE_Catalog

use strict;
use POSIX qw(strftime);
# use vars qw($opt_d $opt_c $opt_t $opt_f);
use vars qw($opt_d $opt_c);
use Getopt::Std;

@main::keywords =
            ("main", "if", "else", "while", "select", "case", "default",
             "class", "abstract_instance", "concrete_instance", "checks",
             "concrete_template", "implements", "extends",
             "encapsulates", "instantiates", "specializes", "employs",
             "function", "is_abstract", "catalyst", "program_body",
             "global_function", "procedure_body", "and",
             "alters", "consumes", "preserves", "produces", "object", "or",
             "not", "mod", "enumeration", "Integer_constant", "self", "NULL",
             "Character_constant", "Real_constant", "Text_constant",
             "default_value", "no_parameters", "standard_abstract_operations",
             "standard_concrete_operations", "assert", "are_distinct_objects",
             "number_of_fields", "field_name", "redeclare_accessor",
             "rep_field_name", "case_select", "utility_procedure",
             "utility_function", "utility_class", "utility_object",
             "standard_assignment_operator", "standard_equality_operators",
             "standard_comparison_operators", "break", "public", "private",
             "protected", "return", "abstract_template", "procedure",
             "global_procedure", "function_body", "Boolean_constant",
             "local_function", "static", "extern", "struct", "new", "delete",
             "local_function_body", "local_procedure_body",
             "utility_function_body", "utility_procedure_body",
             "global_procedure_body", "global_function_body",
             "local_utility_function_body", "local_utility_procedure_body");

@main::mathKeywords =
        ("boolean", "integer", "character", "if", "then", "else", "true",
         "or", "xor", "iff", "implies", "for", "all", "where", "there", "that",
         "product", "function", "from", "to", "differ", "set", "of", "state",
         "universal_set", "union", "without", "intersection", "subset", "is",
         "countable", "string", "empty_string", "math", "operation", "type",
         "elements", "implicit", "explicit", "definition", "permutation",
         "substring", "modeled", "by", "initialization", "preserves", "alters",
         "requires", "ensures", "produces", "exemplar", "theorem", "exists",
         "implements", "concrete_instance", "self", "abstract_instance",
         "convention", "correspondence", "variables", "referenced", "such",
         "maintains", "constraint", "consumes", "restriction", "subtype",
         "finite", "axiom", "empty_set", "in", "div", "mod", "sum", "false",
         "not", "and", "intersect", "prefix", "suffix", "min", "max",
         "reverse", "number_of_fields", "is_initial", "first", "last", "nth",
         "binary", "tree", "root", "children", "elements", "compose",
         "satisfies", "decreases", "empty_tree", "multiset", "empty_multiset");

# other math keywords for math modules
# "mathematics", "parametric", "context", "interface", "end", "facility"

@main::directives =
        ("ifndef", "define", "endif", "else", "ifdef", "undef", "include");

@main::templateParameters =
        ("class", "utility_class", "Integer_constant",
         "Boolean_constant", "Character_constant",
         "Real_constant", "Text_constant");

$main::backgroundColor = "white";
$main::commentColor = "SaddleBrown";
$main::formalCommentColor = "SaddleBrown";
$main::directiveColor = "ForestGreen";
$main::identifierColor = "blue";
$main::lColor = "CD0000";
$main::vColor = "CD0000";
$main::aColor = "red";


sub getTime
{
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
	localtime((stat $_[0])[9]);
    my $str = strftime("%a %b %d %H:%M:%S %Z %Y", $sec, $min, $hour, $mday,
		       $mon, $year, $wday, $yday, $isdst);
    return $str;
}


sub DoFile
{
    my ($src, $dest) = @_;

    my @children;
    my $child;
    my $i;

    print STDOUT "DoFile: $src...\n";

    if (-d $src)
    {
        # print STDOUT "   ...it's a directory\n";

        if (-r $src)
        {
            # print STDOUT "   ...it's readable\n";

            CreateDirectory ($src, $dest);

            @children = <$src/*>;
            foreach $child (@children)
            {
                if (-d $child)
                {
                    $child =~ m(/([^/]+)$);
                    my $newDest = join '/', $dest, $1;
                    DoFile ($child, $newDest);
                }
                else
                {
                    DoFile ($child, $dest);
                }
            }
        }
        else
        {
            # print STDOUT "   ...it's NOT readable\n";
        }
    }
    elsif (-f $src)
    {
        # print STDOUT "   ...it's a file\n";

        if ($src =~ m(([^/]+)\.(h|cpp)$))
        {
            # print STDOUT "   ...it's an RCPP file\n";

            my $name = $1;

            if (-r $src)
            {
                my $title;

                # print STDOUT "   ...it's readable\n";
                my $time = getTime ($src);

                # determine appropriate path
                if ($dest =~ m(^$main::destination/?(.*)$))
                {
                    $main::currentPath = $1;
                    if ($main::currentPath eq "")
                    {
                        $main::currentPath = ".";
                    }
                    else
                    {
                        $main::currentPath =~ s([^/]+)(\.\.)g;
                    }
                }
                else
                {
                    print STDERR "Houston (1), we have a problem!";
                    print STDERR " dest: <$dest>, main::destination: <$main::destination>\n";
                }

                # extract component title
                if ($src =~ m{^(.*?/)((AI|AT|CI|CT).*)$})
                {
                    $title = $2;
                }
                else
                {
                    $title = $src;
                }

                open IN, $src;
                my @allLines = <IN>;
                close IN;
                my $in = join "", @allLines;

                open OUT, ">$dest/$name.html";
                ConvertToHTML ($in, \*OUT, $time, $title);
                close OUT;

                my @s = stat ($src);
                my $m = $s[2] & 07777;
                chmod $m, "$dest/$name.html";
            }
            else
            {
                # print STDOUT "   ...it's NOT readable\n";
            }
        }
        else
        {
            # print STDOUT "   ...it's NOT an RCPP file\n";
        }
    }
    else
    {
        # print STDOUT "   ...it's neither a directory nor a file\n";
    }
}

sub ConvertToHTML
{
    my ($in, $out, $time, $title) = @_;

    my $token;

    PrintHeader ($out, $title);

    while ($in)
    {
        $in =~ s/^(\s+|\w+|\/\/|\/\*!|\/\*|~\w+|.)//s;
        $token = $1;
        if ($token eq "//")
        {
            # this won't work if the newline is escaped with '\'
            $in =~ s/^(.*?)\n//s;
            OneLineComment ($1, $out);
        }
        elsif ($token eq "/*!")
        {
            $in =~ s/^(.*?)!\*\///s;
            FormalComment ($1, $out);
        }
        elsif ($token eq "/*")
        {
            $in =~ s/^(.*?)\*\///s;
            MultiLineComment ($1, $out);
        }
        elsif ($token eq "\"")
        {
            $in =~ s/^([^"\\]*(?:\\.[^"\\]*)*")//s;
            StringLiteral ($1, $out);
        }
        elsif ($token eq "'")
        {
            $in =~ s/^((?:[^\\]|\\.)')//s;
            CharacterLiteral ($1, $out);
        }
        else
        {
            $in = Token ($token, $in, $out);
        }
    }

    PrintFooter ($out, $time);
}


sub FormalComment
{
    my ($in, $out) = @_;

    my $token;

    print $out "<FONT COLOR=\"$main::formalCommentColor\"><I>/*!";

    while ($in)
    {
        $in =~ s/^(\s+|\w+|\/\/|.)//s;
        $token = $1;
        if ($token eq "//")
        {
            # this won't work if the newline is escaped with '\'
            $in =~ s/^(.*?)\n//s;
            OneLineCommentInFormal ($1, $out);
        }
        elsif ($token eq "\"")
        {
            $in =~ s/^([^"\\]*(?:\\.[^"\\]*)*")//s;
            StringLiteral ($1, $out);
        }
        elsif ($token eq "'")
        {
            $in =~ s/^((?:[^\\]|\\.)')//s;
            CharacterLiteral ($1, $out);
        }
        elsif ($token eq "[")
        {
            $in =~ s/^([^\]]*)\]//s;
            InformalComment ($1, $out);
        }
        else
        {
            $in = FormalCommentToken ($token, $in, $out);
        }
    }

    print $out "!*/</I></FONT>";
}


sub OneLineComment
{
    my ($in, $out) = @_;

    $in =~ s/&/&amp;/g;
    $in =~ s/</&lt;/g;
    $in =~ s/>/&gt;/g;
    print $out "<FONT COLOR=\"$main::commentColor\"><I>//$in</I></FONT>\n";
}


sub MultiLineComment
{
    my ($in, $out) = @_;

    $in =~ s/&/&amp;/sg;
    $in =~ s/</&lt;/sg;
    $in =~ s/>/&gt;/sg;
    print $out "<FONT COLOR=\"$main::commentColor\"><I>/*$in*/</I></FONT>";
}


sub StringLiteral
{
    my ($in, $out) = @_;

    $in =~ s/&/&amp;/sg;
    $in =~ s/</&lt;/sg;
    $in =~ s/>/&gt;/sg;
    print $out "\"$in";
}


sub CharacterLiteral
{
    my ($in, $out) = @_;

    $in =~ s/&/&amp;/g;
    $in =~ s/</&lt;/g;
    $in =~ s/>/&gt;/g;
    print $out "'$in";
}


sub Token
{
    my ($token, $in, $out) = @_;

	my $id;

    if ($token eq "<")
    {
        print $out "&lt;";
    }
    elsif ($token eq ">")
    {
        print $out "&gt;";
    }
    elsif ($token eq "&")
    {
        print $out "&amp;";
    }
    elsif ($token eq "#")
    {
        if ($in =~ /^(\w+)/s)
        {
            $id = $1;
            if (grep /^\Q$id\E$/, @main::directives)
            {
                $in =~ s/^\w+//s;
                print $out "<B><FONT COLOR=\"$main::directiveColor\">$token$id</FONT></B>";
                if ($id eq "include")
                {
                    $in = Link ($in, $out);
                }
                elsif (($id eq "define") ||
                       ($id eq "ifdef") ||
                       ($id eq "ifndef") ||
                       ($id eq "undef"))
                {
                    $in = Identifier ($in, $out);
                }
            }
            else
            {
                print $out "#";
            }
        }
        else
        {
            print $out "#";
        }
    }
    elsif (grep /^\Q$token\E$/, @main::keywords)
    {
        print $out "<B>$token</B>";
        if (grep /^\Q$token\E$/, @main::templateParameters)
        {
            $in = BoldIdentifier ($in, $out);
        }
        elsif (($token eq "procedure") ||
               ($token eq "global_procedure") ||
               ($token eq "utility_procedure") ||
               ($token eq "local_procedure_body"))
        {
            $in = ProcedureIdentifier ($in, $out);
        }
        elsif (($token eq "function") ||
               ($token eq "global_function") ||
               ($token eq "utility_function") ||
               ($token eq "local_function_body"))
        {
            $in = FunctionIdentifier ($in, $out);
        }
    }
    elsif (($token =~ /^~?\w+$/s) &&
           ($in =~ /^(?:\s*|\s*\[\]\s*)\([^)]*\)\s*{/s))
    {
        print $out "<FONT COLOR=\"$main::identifierColor\">$token</FONT>";
    }
    else
    {
        print $out "$token";
    }
    return $in;
}


sub OneLineCommentInFormal
{
    my ($in, $out) = @_;

    $in =~ s/&/&amp;/g;
    $in =~ s/</&lt;/g;
    $in =~ s/>/&gt;/g;
    print $out "//$in\n";
}


sub InformalComment
{
    my ($in, $out) = @_;

    $in =~ s/&/&amp;/sg;
    $in =~ s/</&lt;/sg;
    $in =~ s/>/&gt;/sg;
    print $out "[$in]";
}


sub FormalCommentToken
{
    my ($token, $in, $out) = @_;

	my $id;

    if ($token eq "<")
    {
        print $out "&lt;";
    }
    elsif ($token eq ">")
    {
        print $out "&gt;";
    }
    elsif ($token eq "&")
    {
        print $out "&amp;";
    }
    elsif ($token eq "#")
    {
        if ($in =~ /^(\w+)/s)
        {
            $id = $1;
            if (grep /^\Q$id\E$/, @main::directives)
            {
                $in =~ s/^\w+//s;
                print $out "<B>$token$id</B>";
                if ($id eq "include")
                {
                    $in = Link ($in, $out);
                }
            }
            else
            {
                print $out "#";
            }
        }
        else
        {
            print $out "#";
        }
    }
    elsif (grep /^\Q$token\E$/, @main::mathKeywords)
    {
        print $out "<B>$token</B>";
    }
    else
    {
        print $out "$token";
    }
    return $in;
}


sub Link
{
    my ($in, $out) = @_;

    if ($in =~ /^\s+<[^>]+>/s)
    {
        $in =~ s/^(\s+)<([^>]+)>//s;
        print $out "$1&lt;<FONT COLOR=\"$main::identifierColor\">$2</FONT>&gt;";
    }
    elsif ($in =~ /^\s+\"[^\"]+\"/s)
    {
        $in =~ s/^(\s+)\"([^\"]+)\"//s;
        my $ws = $1;
        my $f = $2;
        if ($f !~ /^(.+?)\.h$/)
        {
            print STDERR "Houston (2), we have a problem!";
            print STDERR " f: <$f>\n";
        }
        print $out "$ws\"<A HREF=\"$main::currentPath/$1.html\">$f</A>\"";
    }
    else
    {
        print STDERR "Houston (3), we have a problem!";
        print STDERR " in: <$in>\n";
    }
    return $in;
}


sub Identifier
{
    my ($in, $out) = @_;

    if ($in =~ /^\s+\w+/s)
    {
        $in =~ s/^(\s+)(\w+)//s;
        print $out "$1<FONT COLOR=\"$main::identifierColor\">$2</FONT>";
    }
    else
    {
        print STDERR "Houston (4), we have a problem!";
        print STDERR " in: <$in>\n";
    }
    return $in;
}


sub ProcedureIdentifier
{
    my ($in, $out) = @_;

    if ($in =~ /^\s+\w+/s)
    {
        $in =~ s/^(\s+)(\w+)//s;
        print $out "$1<FONT COLOR=\"$main::identifierColor\">$2</FONT>";
    }
    else
    {
        print STDERR "Houston (5), we have a problem!";
        print STDERR " in: <$in>\n";
    }
    return $in;
}


sub FunctionIdentifier
{
    my ($in, $out) = @_;

    if ($in =~ /^\s+[\w\#]+&?\s+\w+/s)
    {
        $in =~ s/^(\s+)([\w\#]+)(&?)(\s+)(\w+)//s;
        print $out "$1$2";
        if ($3 eq "&")
        {
            print $out "&amp;";
        }
        print $out "$4<FONT COLOR=\"$main::identifierColor\">$5</FONT>";
    }
    else
    {
        print STDERR "Houston (6), we have a problem!";
        print STDERR " in: <$in>\n";
    }
    return $in;
}


sub BoldIdentifier
{
    my ($in, $out) = @_;

    if ($in =~ /^\s+\w+/s)
    {
        $in =~ s/^(\s+)(\w+)//s;
        print $out "$1<B><I><FONT COLOR=\"$main::identifierColor\">$2</FONT></I></B>";
    }
    else
    {
        print STDERR "Houston (7), we have a problem!";
        print STDERR " in: <$in>\n";
    }
    return $in;
}


sub PrintHeader
{
    my ($out, $title) = @_;

    my $link = GetLink ($title);

    print $out "<HTML>\n";
    print $out "<HEAD>\n";
    print $out "<TITLE>$title</TITLE>\n";
    print $out "</HEAD>\n";
    print $out "<BODY BGCOLOR=\"$main::backgroundColor\" LINK=\"$main::lColor";
    print $out "\" VLINK=\"$main::vColor\" ALINK=\"$main::aColor\">\n";
    print $out "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=\"100%\">\n";
    print $out "<TR>\n<TD ALIGN=left>\n";
    print $out "<A HREF=\"$main::currentPath/index.html\"><FONT SIZE=6><B>$main::catalog</B></FONT></A>\n";
    print $out "</TD>\n";
    print $out "<TD ROWSPAN=3 ALIGN=right VALIGN=top>\n";
    print $out "<A HREF=\"http://www.cse.ohio-state.edu/rsrg/\">";
    print $out "<IMG SRC=\"$main::currentPath/rsrg-logo.gif\" WIDTH=120 HEIGHT=120 BORDER=0>";
    print $out "</A>\n</TD>\n";
    print $out "</TR>\n";
    print $out "<TR>\n<TD ALIGN=left>\n";
    print $out "<A HREF=\"$main::currentPath/$link\"><FONT SIZE=5><B>$title</B></FONT></A>\n";
    print $out "</TD>\n</TR>\n";
    print $out "<TR>\n<TD ALIGN=left>\n";
    print $out "<FONT SIZE=2>Copyright &copy; ";
    print $out ((localtime)[5] + 1900); # this prints the current year
    print $out ", Reusable Software Research Group";
    print $out ", The Ohio State University</FONT>\n";
    print $out "</TD>\n</TR>\n";
    print $out "</TABLE>\n";
    print $out "<HR SIZE=1 NOSHADE>\n";
    print $out "<PRE>\n";
}


sub GetLink
{
    my ($component) = @_;

    my $link;

    if ($component =~ m{^(AI|AT|CI|CT)/(.*?)/(.+)(.h|.cpp)$})
    {
        if (($1 eq "AI") || ($1 eq "AT"))
        {
            $link = $2 . "_A.html";
        }
        else
        {
            $link = $2;

            my $tmp = $3;

            if ($tmp =~ /^(.*?)_Body/)
            {
                $tmp = $1;
            }
            if ($tmp =~ /^(.*?)_C$/)
            {
                $tmp = $1;
            }
            if ($tmp =~ /^(.*?)_[0-9][a-z]?L?$/)
            {
                $tmp = $1;
            }
            $link = $link . "_" . $tmp . "_C.html";
        }
    }
    else
    {
        $link = "";
    }
    return $link;
}


sub PrintFooter
{
    my ($out, $time) = @_;

    print $out "</PRE>\n";
    print $out "<HR SIZE=1 NOSHADE>\n";
    print $out "Last modified: $time\n";
    print $out "</BODY>\n";
    print $out "</HTML>\n";
}


sub CreateDirectory
{
    my ($src, $dest) = @_;

    if (not -e $dest)
    {
        mkdir $dest, 0777;
    }
    my @s = stat ($src);
    my $m = $s[2] & 07777;
    chmod $m, $dest;
}


####################
### Main Program ###
####################

use FileHandle;
STDOUT->autoflush (1);

$opt_c = "";
$opt_d = ".";
# $opt_f = "";
# $opt_t = "";

# if (getopts ('c:d:f:t:'))
if (getopts ('c:d:'))
{
    if ($opt_c ne "")
    {
        my $i;
        $main::catalog = $opt_c;
        $main::destination = $opt_d;
        # $main::family = $opt_f;
        # $main::type = $opt_t;

        $main::currentPath = "";

        for ($i = 0; $i <= $#ARGV; $i++)
        {
            $ARGV[$i] =~ s(/?$)();
            DoFile ($ARGV[$i], $main::destination);
        }
    }
    else
    {
        # die "Usage: rcpp2html -c catalog [-t type] [-f family] [-d destination] files\n"
        die "Usage: rcpp2html -c catalog [-d destination] files\n"
    }
}
else
{
    # die "Usage: rcpp2html -c catalog [-t type] [-f family] [-d destination] files\n"
    die "Usage: rcpp2html -c catalog [-d destination] files\n"
}