path: root/docs/exdoc

#!/usr/bin/perl

use warnings;
use strict;

use Getopt::Long;
use Pod::Usage;

# Options
my $HELP = 0;
my $SOURCE_DIR = '';
my $TARGET_DIR = '';
my $WARNINGS = 0;

GetOptions(
    "help" => \$HELP,
    "html|h=s" => \$SOURCE_DIR,
    "target|t=s" => \$TARGET_DIR,
    "warnings|W" => \$WARNINGS,
) or pod2usage(1);

pod2usage(0) if $HELP;

exdoc();

#
# Main entry point.
#
sub exdoc {
    my %templates = ();
    my %docs = ();
    my $stylesheet = load_stylesheet($SOURCE_DIR);
    load_templates($SOURCE_DIR, \%templates);
    process_source_files(\%docs);
    merge(\%docs, \%templates, \$stylesheet);
}

#
# Load CSS stylesheet.
#
sub load_stylesheet {
    my ($dir_path) = @_;
    my $file_path = "$dir_path/api-style.css";
    open (my $file, '<', $file_path) or die "Could not open $file_path";
    local $/;
    my $contents = <$file>;
    close $file;
    return $contents;
}

#
# Load HTML templates.
#
sub load_templates {
    my ($dir_path, $templates) = @_;
    opendir (my $dir, "$dir_path/sources/") or die "Could not open $dir_path";
    while (my $file_name = readdir ($dir)) {
        next if $file_name !~ /mono-api-.*\.html$/;
        open (my $file, "$dir_path/sources/$file_name") or die "Could not open $file_name";
        my $contents = '';
        my @api = ();
        while (<$file>) {
            $contents .= $_;
            if (/name="api:(.*?)"/) {
                s/.*name="api:(\w+?)".*/$1/;
                push @api, $_;
            }
        }
        close $file;
        $templates->{$file_name}->{contents} = $contents;
        $templates->{$file_name}->{api} = \@api;
    }
    closedir $dir;
}

#
# Extract documentation from all source files.
#
sub process_source_files {
    my ($docs) = @_;
    for my $file_path (@ARGV) {
        process_source_file($file_path, $docs);
    }
}

#
# Extract documentation from a single source file.
#
sub process_source_file {
    my ($file_path, $docs) = @_;
    open (my $file, '<', $file_path) or die "Could not open $file_path";
    while (<$file>) {
        next if (!/\/\*\* *\n/);
        process_function($file, $file_path, $docs);
    }
    close $file;
}

#
# Extract documentation from a single function.
#
sub process_function {

    my ($file, $file_path, $docs) = @_;

    my $PARAMETER_SECTION = 0;
    my $BODY_SECTION = 1;
    my $RETURN_SECTION = 2;
    my $section = $PARAMETER_SECTION;

    my $name = do {
        $_ = <$file>;
        chomp;
        s/^ \* //;
        s/:$//;
        $_
    };

    # Ignore irrelevant functions, and those with the wrong doc format.
    return if $name !~ /^mono_\w+$/;

    my $deprecated;
    my @parameters = ();
    my $body = '';
    my $returns = '';
    my $prototype = '';
    my $codeblock = 'false';

    while (<$file>) {

        # We've reached the last line in the documentation block.
        if (/^ \*\*?\//) {

            # Grab function prototype.
            while (<$file>) {
                $prototype .= $_;
                last if /\{/;
            }

            # Clean up prototype.
            $prototype = do {
                $_ = $prototype;
                # Strip braces and trailing whitespace.
                s/{//;
                s/ +$//;
                # Turn "Type * xxx" into "Type* xxx"
                s/^(\w+)\W+\*/$1*/;
                $_;
            };

            # Process formatting within sections.
            for my $parameter (@parameters) {
                process_formatting(\$parameter->{description}, $file_path, $.);
            }
            process_formatting(\$returns, $file_path, $.);
            process_formatting(\$body, $file_path, $.);
            if (defined($deprecated)) {
                process_formatting(\$deprecated, $file_path, $.);
            }

            if (exists($docs->{body}->{$name})) {
                my $origin = $docs->{origin}->{$name};
                if ($WARNINGS) {
                    warn
                      "$file_path:$.: Redundant documentation for $name\n",
                      "$origin->{file}:$origin->{line}: Previously defined here\n";
                }
            }
            $docs->{origin}->{$name} = { file => $file_path, line => $. };
            $docs->{body}->{$name} = $body;
            $docs->{parameters}->{$name} = \@parameters;
            $docs->{deprecated}->{$name} = $deprecated if defined $deprecated;
            $docs->{return}->{$name} = $returns;
            $docs->{prototype}->{$name} = $prototype;
            last;

        }

        # Strip newlines and asterisk prefix.
        chomp;
        s/^ +\*//;

        if (/\s*\\code$/) {
            $codeblock = 'true';
        } elsif (/\s*\\endcode$/) {
            $codeblock = 'false';
        }

        # Replace blank lines with paragraph breaks if we're not in a code block.
        if (/^\s*$/) {
            $_ = '<p>' if $codeblock eq 'false';
        }

        if ($section == $PARAMETER_SECTION) {
            if (/\s*\\param +(\w+)(.*)/) {
                # print "$file_path:$.: warning: Got parameter $1\n";
                push @parameters, { name => $1, description => $2 };
            } elsif (/\s*\\deprecated(.*)/) {
                # print "$file_path:$.: warning: Got deprecated annotation\n";
                $deprecated = $1;
            } elsif (/\s*(\w+):(.*)/) {
                if ($1 eq 'deprecated') {
                    warn "$file_path:$.: Old-style monodoc notation 'deprecated:' used\n"
                        if $WARNINGS;
                    $deprecated = $2;
                } else {
                    warn "$file_path:$.: Old-style monodoc notation 'param:' used\n"
                        if $WARNINGS;
                    push @parameters, { name => $1, description => $2 };
                }
            } else {
                # $body = "\t$_\n";
                $section = $BODY_SECTION;
                redo;
            }
        } elsif ($section == $BODY_SECTION) {
            if (s/(Returns?:\s*|\\returns?\s*)//) {
                $returns = "\t$_\n";
                $section = $RETURN_SECTION;
            } else {
                $body .= "\n$_";
            }
        } elsif ($section == $RETURN_SECTION) {
            $returns .= "\n\t$_";
        } else {
            die "Invalid section $section\n";
        }
    }
}

#
# Substitute formatting within documentation text.
#
sub process_formatting {
    my ($content, $file_path, $current_line) = @_;
    $_ = $$content;

    # General formatting
    s{\\b +(\w+)}{<strong>$1</strong>}g;
    s{\\a +(\w+)}{<i>$1</i>}g;
    s{\\e +(\w+)}{<i>$1</i>}g;
    s{\\em +(\w+)}{<i>$1</i>}g;

    # Constants
    s{NULL}{<code>NULL</code>}g;
    s{TRUE}{<code>TRUE</code>}g;
    s{FALSE}{<code>FALSE</code>}g;

    # Parameters
    warn "$file_path:$current_line: Old-style monodoc notation '\@param' used\n"
        if s{@(\w+)}{<i>$1</i>}g && $WARNINGS;
    s{\\p +(\w+)}{<i>$1</i>}g;

    # Code
    warn "$file_path:$current_line: Old-style monodoc notation '#code' used\n"
        if s{#(\w+)}{<code>$1</code>}g && $WARNINGS;
    warn "$file_path:$current_line: Old-style monodoc notation '`code`' used\n"
        if s{\`((?!api:)[:.\w\*]+)\`}{<code>$1</code>}g && $WARNINGS;
    s{\\c +(\S+(?<![.,:;]))}{<code>$1</code>}g;
    s{\\code}{<pre><code class="mapi-codeblock">}g;
    s{\\endcode}{</code></pre>}g;

    $$content = $_;
}

#
# Merge templates with stylesheet and documentation extracted from sources.
#
sub merge {
    my ($docs, $templates, $stylesheet) = @_;
    my $last = '';
    for my $name (keys %$templates) {
        open (my $output_file, '>', "$TARGET_DIR/html/$name")
          or die "Could not create $TARGET_DIR/html/$name";
        print "Merging: $name\n";
        print $output_file <<EOF;
<?xml version="1.0" encoding="utf-8"?>
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
    <title>$name</title>
    <style type="text/css">
$stylesheet
   </style>
</head>
<body>
<div class="mapi-docs">
EOF
        my @a = split (/\n/, $templates->{$name}->{contents});
        my $strike = '';
        my $strikeextra = '';
        my $api_shown = 0;
        for (my $ai = 0; $ai < $#a; $ai++) {
            my $line = $a[$ai];
            if (my ($api, $caption) = ($line =~ /<h4><a name=\"api:(\w+)\">(\w+)<\/a><\/h4>/)) {
                if ($api_shown == 1) {
                    print $output_file "</div> <!-- class=mapi -->\n\n";
                    if ($docs->{deprecated}->{$api}) {
                        $strike = "mapi-strike";
                        $strikeextra = "</div><br><div class='mapi-deprecated'><b>Deprecated:</b> " . $docs->{deprecated}->{$api};
                    } else {
                        $strike = "";
                        $strikeextra = "";
                    }
                }
                $api_shown = 1;
                my $proto = $docs->{prototype}->{$api} // $api;

                print $output_file <<EOF;
<a name="api:$api"></a>
<div class="mapi">
    <div class="mapi-entry $strike"><code>$api$strikeextra</code></div>
    <div class="mapi-height-container">
        <div class="mapi-ptr-container"></div>
        <div class="mapi-description">
            <div class="mapi-ptr"></div>

            <div class="mapi-declaration mapi-section">Syntax</div>
            <div class="mapi-prototype">$proto</div>
            <p>
EOF
                if (exists ($docs->{parameters}->{$api})) {
                    my $ppars = $docs->{parameters}->{$api};
                    if (@$ppars) {
                        print $output_file
                          "            <div class=\"mapi-section\">Parameters</div>\n",
                          "            <table class=\"mapi-parameters\"><tbody>",
                          render_parameters($ppars),
                          "</tbody></table>";
                    }
                }

                opt_print ($output_file, "Return value", $docs->{return}->{$api});
                opt_print ($output_file, "Description", $docs->{body}->{$api});
                print $output_file "        </div><!--mapi-description-->\n    </div><!--height container-->\n";
            } else {
                if ($line =~ /\@API_IDX\@/) {
                    my $apis_toc = create_toc ($docs, $templates->{$name}->{api});
                    $line =~ s/\@API_IDX\@/$apis_toc/;
                }
                if ($line =~ /^<h4/) {
                    print $output_file "</div>\n";
                    $api_shown = 0;
                }
                if ($line =~ /`/) {
                }
                print $output_file "$line\n";
            }
        }
        print $output_file
          "   </div>",
          "</body>",
          "</html>";
        close $output_file;
        system ("$ENV{runtimedir}/mono-wrapper convert.exe $TARGET_DIR/html/$name $TARGET_DIR/html/x-$name");

        # Clean up the mess that AgilityPack makes (it CDATAs our CSS).
        open (my $hack_input, '<', "$TARGET_DIR/html/x-$name")
          or die "Could not open $TARGET_DIR/html/x-$name";
        open (my $hack_output, '>', "$TARGET_DIR/deploy/$name")
          or die "Could not open output";

        my $line = 0;
        my $doprint = 0;
        while (<$hack_input>) {
            print $hack_output $last if ($doprint);
            $line++;
            s/^\/\/<!\[CDATA\[//;
            s/^\/\/\]\]>\/\///;

            # Remove the junk <span> wrapper generated by AgilityPack.
            if ($line==1) {
                s/<span>//;
            }
            if (/<style type/) {
                # Replace the CSS in the XHTML output with the original CSS.
                print $hack_output $_;
                print $hack_output $$stylesheet;
                while (<$hack_input>) {
                    last if (/<\/style>/);
                }
            }
            $last = $_;
            $doprint = 1;
        }
        if (!($last =~ /span/)) {
            print $hack_output $last;
        }
        # system ("cp.exe $TARGET_DIR/html/$name $TARGET_DIR/deploy/$name");
    }
}

sub create_toc {
    my ($docs, $apis_listed) = @_;
    my $type_size = 0;
    my $name_size = 0;
    my ($ret, $xname, $args);
    my $apis_toc = "";

    # Try to align things; compute type size, method size, and arguments.
    foreach my $line (split /\n/, $apis_listed) {
        if (exists ($docs->{prototype}->{$line})) {
            my $p = $docs->{prototype}->{$line};
            if (my ($ret, $xname, $args) = ($p =~ /(.*)\n(\w+)[ \t](.*)/)) {
                my $tl = length ($ret);
                my $pl = length ($xname);
                $type_size = $tl if ($tl > $type_size);
                $name_size = $pl if ($pl > $name_size);
            }
        }
    }

    $type_size++;
    $name_size++;

    foreach my $line (split /\n/, $apis_listed) {
        chomp($line);
        if (exists($docs->{prototype}->{$line})) {
            my $p = $docs->{prototype}->{$line};
            if (my ($ret, $xname, $args) = ($p =~ /(.*)\n(\w+)[ \t](.*)/)) {
                $xname = $line if $xname eq "";
                my $rspace = " " x ($type_size - length ($ret));
                my $nspace = " " x ($name_size - length ($xname));
                $args = wrap ($args, length ($ret . $rspace . $xname . $nspace), 60);
                $apis_toc .= "$ret$rspace<a href=\"\#api:$line\">$xname</a>$nspace$args\n";
            }
        }
    }
    return $apis_toc;
}

sub wrap {
    my ($args, $size, $limit) = @_;
    my $sret = "";

    # return $args if ((length (args) + size) < $limit);
    
    my $remain = $limit - $size;
    my @sa = split /,/, $args;
    my $linelen = $size;
    foreach my $arg (@sa) {
        if ($sret eq "") {
            $sret = $arg . ", ";
            $linelen += length ($sret);
        } else {
            if ($linelen + length ($arg) < $limit) {
                $sret .= "FITS" . $arg . ", ";
            } else {
                my $newline = " " x ($size) . $arg . ", ";
                my $linelen = length ($newline);
                $sret .= "\n" . $newline;
            }
        }
    }
    $sret =~ s/, $/;/;
    return $sret;
}

#
# Print a section if non-empty.
#
sub opt_print {
    my ($output, $caption, $opttext) = @_;
    if (defined($opttext) && $opttext ne '' && $opttext !~ /^[ \t]+$/) {
        print $output
          "             <div class=\"mapi-section\">$caption</div>\n",
          "             <div>$opttext</div>\n";
    }
}

#
# Render parameter information as table.
#
sub render_parameters {
    my ($parameters) = @_;
    my $result = '';
    for my $parameter (@$parameters) {
        $result .= "<tr><td><i>$parameter->{name}</i></td><td>$parameter->{description}</td></tr>";
    }
    return $result;
}

__END__

=head1 NAME

exdoc - Compiles API docs from Mono sources and HTML templates.

=head1 SYNOPSIS

    exdoc [OPTIONS] [FILE...]

=head1 OPTIONS

=over 4

=item B<--help>

Print this help message.

=item B<--html> I<DIR>, B<-h> I<DIR>

Use I<DIR> as the input path for HTML sources.

=item B<--target> I<DIR>, B<-t> I<DIR>

Use I<DIR> as the target path for output.

=item B<--warnings>, B<-W>

Enable warnings about documentation errors.

=back

=head1 DESCRIPTION

Reads HTML templates and C sources, extracting documentation from the sources and splicing it into the templates.

=cut