#!/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