docs/exdoc

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Getopt::Long;
   7 use Pod::Usage;
   8
   9 # Options
  10 my $HELP = 0;
  11 my $SOURCE_DIR = '';
  12 my $TARGET_DIR = '';
  13 my $WARNINGS = 0;
  14
  15 GetOptions(
  16     "help" => \$HELP,
  17     "html|h=s" => \$SOURCE_DIR,
  18     "target|t=s" => \$TARGET_DIR,
  19     "warnings|W" => \$WARNINGS,
  20 ) or pod2usage(1);
  21
  22 pod2usage(0) if $HELP;
  23
  24 exdoc();
  25
  26 #
  27 # Main entry point.
  28 #
  29 sub exdoc {
  30     my %templates = ();
  31     my %docs = ();
  32     my $stylesheet = load_stylesheet($SOURCE_DIR);
  33     load_templates($SOURCE_DIR, \%templates);
  34     process_source_files(\%docs);
  35     merge(\%docs, \%templates, \$stylesheet);
  36 }
  37
  38 #
  39 # Load CSS stylesheet.
  40 #
  41 sub load_stylesheet {
  42     my ($dir_path) = @_;
  43     my $file_path = "$dir_path/api-style.css";
  44     open (my $file, '<', $file_path) or die "Could not open $file_path";
  45     local $/;
  46     my $contents = <$file>;
  47     close $file;
  48     return $contents;
  49 }
  50
  51 #
  52 # Load HTML templates.
  53 #
  54 sub load_templates {
  55     my ($dir_path, $templates) = @_;
  56     opendir (my $dir, "$dir_path/sources/") or die "Could not open $dir_path";
  57     while (my $file_name = readdir ($dir)) {
  58         next if $file_name !~ /mono-api-.*\.html$/;
  59         open (my $file, "$dir_path/sources/$file_name") or die "Could not open $file_name";
  60         my $contents = '';
  61         my @api = ();
  62         while (<$file>) {
  63             $contents .= $_;
  64             if (/name="api:(.*?)"/) {
  65                 s/.*name="api:(\w+?)".*/$1/;
  66                 push @api, $_;
  67             }
  68         }
  69         close $file;
  70         $templates->{$file_name}->{contents} = $contents;
  71         $templates->{$file_name}->{api} = \@api;
  72     }
  73     closedir $dir;
  74 }
  75
  76 #
  77 # Extract documentation from all source files.
  78 #
  79 sub process_source_files {
  80     my ($docs) = @_;
  81     for my $file_path (@ARGV) {
  82         process_source_file($file_path, $docs);
  83     }
  84 }
  85
  86 #
  87 # Extract documentation from a single source file.
  88 #
  89 sub process_source_file {
  90     my ($file_path, $docs) = @_;
  91     open (my $file, '<', $file_path) or die "Could not open $file_path";
  92     while (<$file>) {
  93         next if (!/\/\*\* *\n/);
  94         process_function($file, $file_path, $docs);
  95     }
  96     close $file;
  97 }
  98
  99 #
 100 # Extract documentation from a single function.
 101 #
 102 sub process_function {
 103
 104     my ($file, $file_path, $docs) = @_;
 105
 106     my $PARAMETER_SECTION = 0;
 107     my $BODY_SECTION = 1;
 108     my $RETURN_SECTION = 2;
 109     my $section = $PARAMETER_SECTION;
 110
 111     my $name = do {
 112         $_ = <$file>;
 113         chomp;
 114         s/^ \* //;
 115         s/:$//;
 116         $_
 117     };
 118
 119     # Ignore irrelevant functions, and those with the wrong doc format.
 120     return if $name !~ /^mono_\w+$/;
 121
 122     my $deprecated;
 123     my @parameters = ();
 124     my $body = '';
 125     my $returns = '';
 126     my $prototype = '';
 127     my $codeblock = 'false';
 128
 129     while (<$file>) {
 130
 131         # We've reached the last line in the documentation block.
 132         if (/^ \*\*?\//) {
 133
 134             # Grab function prototype.
 135             while (<$file>) {
 136                 $prototype .= $_;
 137                 last if /\{/;
 138             }
 139
 140             # Clean up prototype.
 141             $prototype = do {
 142                 $_ = $prototype;
 143                 # Strip braces and trailing whitespace.
 144                 s/{//;
 145                 s/ +$//;
 146                 # Turn "Type * xxx" into "Type* xxx"
 147                 s/^(\w+)\W+\*/$1*/;
 148                 $_;
 149             };
 150
 151             # Process formatting within sections.
 152             for my $parameter (@parameters) {
 153                 process_formatting(\$parameter->{description}, $file_path, $.);
 154             }
 155             process_formatting(\$returns, $file_path, $.);
 156             process_formatting(\$body, $file_path, $.);
 157             if (defined($deprecated)) {
 158                 process_formatting(\$deprecated, $file_path, $.);
 159             }
 160
 161             if (exists($docs->{body}->{$name})) {
 162                 my $origin = $docs->{origin}->{$name};
 163                 if ($WARNINGS) {
 164                     warn
 165                       "$file_path:$.: Redundant documentation for $name\n",
 166                       "$origin->{file}:$origin->{line}: Previously defined here\n";
 167                 }
 168             }
 169             $docs->{origin}->{$name} = { file => $file_path, line => $. };
 170             $docs->{body}->{$name} = $body;
 171             $docs->{parameters}->{$name} = \@parameters;
 172             $docs->{deprecated}->{$name} = $deprecated if defined $deprecated;
 173             $docs->{return}->{$name} = $returns;
 174             $docs->{prototype}->{$name} = $prototype;
 175             last;
 176
 177         }
 178
 179         # Strip newlines and asterisk prefix.
 180         chomp;
 181         s/^ +\*//;
 182
 183         if (/\s*\\code$/) {
 184             $codeblock = 'true';
 185         } elsif (/\s*\\endcode$/) {
 186             $codeblock = 'false';
 187         }
 188
 189         # Replace blank lines with paragraph breaks if we're not in a code block.
 190         if (/^\s*$/) {
 191             $_ = '<p>' if $codeblock eq 'false';
 192         }
 193
 194         if ($section == $PARAMETER_SECTION) {
 195             if (/\s*\\param +(\w+)(.*)/) {
 196                 # print "$file_path:$.: warning: Got parameter $1\n";
 197                 push @parameters, { name => $1, description => $2 };
 198             } elsif (/\s*\\deprecated(.*)/) {
 199                 # print "$file_path:$.: warning: Got deprecated annotation\n";
 200                 $deprecated = $1;
 201             } elsif (/\s*(\w+):(.*)/) {
 202                 if ($1 eq 'deprecated') {
 203                     warn "$file_path:$.: Old-style monodoc notation 'deprecated:' used\n"
 204                         if $WARNINGS;
 205                     $deprecated = $2;
 206                 } else {
 207                     warn "$file_path:$.: Old-style monodoc notation 'param:' used\n"
 208                         if $WARNINGS;
 209                     push @parameters, { name => $1, description => $2 };
 210                 }
 211             } else {
 212                 # $body = "\t$_\n";
 213                 $section = $BODY_SECTION;
 214                 redo;
 215             }
 216         } elsif ($section == $BODY_SECTION) {
 217             if (s/(Returns?:\s*|\\returns?\s*)//) {
 218                 $returns = "\t$_\n";
 219                 $section = $RETURN_SECTION;
 220             } else {
 221                 $body .= "\n$_";
 222             }
 223         } elsif ($section == $RETURN_SECTION) {
 224             $returns .= "\n\t$_";
 225         } else {
 226             die "Invalid section $section\n";
 227         }
 228     }
 229 }
 230
 231 #
 232 # Substitute formatting within documentation text.
 233 #
 234 sub process_formatting {
 235     my ($content, $file_path, $current_line) = @_;
 236     $_ = $$content;
 237
 238     # General formatting
 239     s{\\b +(\w+)}{<strong>$1</strong>}g;
 240     s{\\a +(\w+)}{<i>$1</i>}g;
 241     s{\\e +(\w+)}{<i>$1</i>}g;
 242     s{\\em +(\w+)}{<i>$1</i>}g;
 243
 244     # Constants
 245     s{NULL}{<code>NULL</code>}g;
 246     s{TRUE}{<code>TRUE</code>}g;
 247     s{FALSE}{<code>FALSE</code>}g;
 248
 249     # Parameters
 250     warn "$file_path:$current_line: Old-style monodoc notation '\@param' used\n"
 251         if s{@(\w+)}{<i>$1</i>}g && $WARNINGS;
 252     s{\\p +(\w+)}{<i>$1</i>}g;
 253
 254     # Code
 255     warn "$file_path:$current_line: Old-style monodoc notation '#code' used\n"
 256         if s{#(\w+)}{<code>$1</code>}g && $WARNINGS;
 257     warn "$file_path:$current_line: Old-style monodoc notation '`code`' used\n"
 258         if s{\`((?!api:)[:.\w\*]+)\`}{<code>$1</code>}g && $WARNINGS;
 259     s{\\c +(\S+(?<![.,:;]))}{<code>$1</code>}g;
 260     s{\\code}{<pre><code class="mapi-codeblock">}g;
 261     s{\\endcode}{</code></pre>}g;
 262
 263     $$content = $_;
 264 }
 265
 266 #
 267 # Merge templates with stylesheet and documentation extracted from sources.
 268 #
 269 sub merge {
 270     my ($docs, $templates, $stylesheet) = @_;
 271     my $last = '';
 272     for my $name (keys %$templates) {
 273         open (my $output_file, '>', "$TARGET_DIR/html/$name")
 274           or die "Could not create $TARGET_DIR/html/$name";
 275         print "Merging: $name\n";
 276         print $output_file <<EOF;
 277 <?xml version="1.0" encoding="utf-8"?>
 278 <html xmlns="http://www.w3.org/1999/xhtml">
 279 <head>
 280     <title>$name</title>
 281     <style type="text/css">
 282 $stylesheet
 283    </style>
 284 </head>
 285 <body>
 286 <div class="mapi-docs">
 287 EOF
 288         my @a = split (/\n/, $templates->{$name}->{contents});
 289         my $strike = '';
 290         my $strikeextra = '';
 291         my $api_shown = 0;
 292         for (my $ai = 0; $ai < $#a; $ai++) {
 293             my $line = $a[$ai];
 294             if (my ($api, $caption) = ($line =~ /<h4><a name=\"api:(\w+)\">(\w+)<\/a><\/h4>/)) {
 295                 if ($api_shown == 1) {
 296                     print $output_file "</div> <!-- class=mapi -->\n\n";
 297                     if ($docs->{deprecated}->{$api}) {
 298                         $strike = "mapi-strike";
 299                         $strikeextra = "</div><br><div class='mapi-deprecated'><b>Deprecated:</b> " . $docs->{deprecated}->{$api};
 300                     } else {
 301                         $strike = "";
 302                         $strikeextra = "";
 303                     }
 304                 }
 305                 $api_shown = 1;
 306                 my $proto = $docs->{prototype}->{$api} // $api;
 307
 308                 print $output_file <<EOF;
 309 <a name="api:$api"></a>
 310 <div class="mapi">
 311     <div class="mapi-entry $strike"><code>$api$strikeextra</code></div>
 312     <div class="mapi-height-container">
 313         <div class="mapi-ptr-container"></div>
 314         <div class="mapi-description">
 315             <div class="mapi-ptr"></div>
 316
 317             <div class="mapi-declaration mapi-section">Syntax</div>
 318             <div class="mapi-prototype">$proto</div>
 319             <p>
 320 EOF
 321                 if (exists ($docs->{parameters}->{$api})) {
 322                     my $ppars = $docs->{parameters}->{$api};
 323                     if (@$ppars) {
 324                         print $output_file
 325                           "            <div class=\"mapi-section\">Parameters</div>\n",
 326                           "            <table class=\"mapi-parameters\"><tbody>",
 327                           render_parameters($ppars),
 328                           "</tbody></table>";
 329                     }
 330                 }
 331
 332                 opt_print ($output_file, "Return value", $docs->{return}->{$api});
 333                 opt_print ($output_file, "Description", $docs->{body}->{$api});
 334                 print $output_file "        </div><!--mapi-description-->\n    </div><!--height container-->\n";
 335             } else {
 336                 if ($line =~ /\@API_IDX\@/) {
 337                     my $apis_toc = create_toc ($docs, $templates->{$name}->{api});
 338                     $line =~ s/\@API_IDX\@/$apis_toc/;
 339                 }
 340                 if ($line =~ /^<h4/) {
 341                     print $output_file "</div>\n";
 342                     $api_shown = 0;
 343                 }
 344                 if ($line =~ /`/) {
 345                 }
 346                 print $output_file "$line\n";
 347             }
 348         }
 349         print $output_file
 350           "   </div>",
 351           "</body>",
 352           "</html>";
 353         close $output_file;
 354         system ("$ENV{runtimedir}/mono-wrapper convert.exe $TARGET_DIR/html/$name $TARGET_DIR/html/x-$name");
 355
 356         # Clean up the mess that AgilityPack makes (it CDATAs our CSS).
 357         open (my $hack_input, '<', "$TARGET_DIR/html/x-$name")
 358           or die "Could not open $TARGET_DIR/html/x-$name";
 359         open (my $hack_output, '>', "$TARGET_DIR/deploy/$name")
 360           or die "Could not open output";
 361
 362         my $line = 0;
 363         my $doprint = 0;
 364         while (<$hack_input>) {
 365             print $hack_output $last if ($doprint);
 366             $line++;
 367             s/^\/\/<!\[CDATA\[//;
 368             s/^\/\/\]\]>\/\///;
 369
 370             # Remove the junk <span> wrapper generated by AgilityPack.
 371             if ($line==1) {
 372                 s/<span>//;
 373             }
 374             if (/<style type/) {
 375                 # Replace the CSS in the XHTML output with the original CSS.
 376                 print $hack_output $_;
 377                 print $hack_output $$stylesheet;
 378                 while (<$hack_input>) {
 379                     last if (/<\/style>/);
 380                 }
 381             }
 382             $last = $_;
 383             $doprint = 1;
 384         }
 385         if (!($last =~ /span/)) {
 386             print $hack_output $last;
 387         }
 388         # system ("cp.exe $TARGET_DIR/html/$name $TARGET_DIR/deploy/$name");
 389     }
 390 }
 391
 392 sub create_toc {
 393     my ($docs, $apis_listed) = @_;
 394     my $type_size = 0;
 395     my $name_size = 0;
 396     my ($ret, $xname, $args);
 397     my $apis_toc = "";
 398
 399     # Try to align things; compute type size, method size, and arguments.
 400     foreach my $line (split /\n/, $apis_listed) {
 401         if (exists ($docs->{prototype}->{$line})) {
 402             my $p = $docs->{prototype}->{$line};
 403             if (my ($ret, $xname, $args) = ($p =~ /(.*)\n(\w+)[ \t](.*)/)) {
 404                 my $tl = length ($ret);
 405                 my $pl = length ($xname);
 406                 $type_size = $tl if ($tl > $type_size);
 407                 $name_size = $pl if ($pl > $name_size);
 408             }
 409         }
 410     }
 411
 412     $type_size++;
 413     $name_size++;
 414
 415     foreach my $line (split /\n/, $apis_listed) {
 416         chomp($line);
 417         if (exists($docs->{prototype}->{$line})) {
 418             my $p = $docs->{prototype}->{$line};
 419             if (my ($ret, $xname, $args) = ($p =~ /(.*)\n(\w+)[ \t](.*)/)) {
 420                 $xname = $line if $xname eq "";
 421                 my $rspace = " " x ($type_size - length ($ret));
 422                 my $nspace = " " x ($name_size - length ($xname));
 423                 $args = wrap ($args, length ($ret . $rspace . $xname . $nspace), 60);
 424                 $apis_toc .= "$ret$rspace<a href=\"\#api:$line\">$xname</a>$nspace$args\n";
 425             }
 426         }
 427     }
 428     return $apis_toc;
 429 }
 430
 431 sub wrap {
 432     my ($args, $size, $limit) = @_;
 433     my $sret = "";
 434
 435     # return $args if ((length (args) + size) < $limit);
 436
 437     my $remain = $limit - $size;
 438     my @sa = split /,/, $args;
 439     my $linelen = $size;
 440     foreach my $arg (@sa) {
 441         if ($sret eq "") {
 442             $sret = $arg . ", ";
 443             $linelen += length ($sret);
 444         } else {
 445             if ($linelen + length ($arg) < $limit) {
 446                 $sret .= "FITS" . $arg . ", ";
 447             } else {
 448                 my $newline = " " x ($size) . $arg . ", ";
 449                 my $linelen = length ($newline);
 450                 $sret .= "\n" . $newline;
 451             }
 452         }
 453     }
 454     $sret =~ s/, $/;/;
 455     return $sret;
 456 }
 457
 458 #
 459 # Print a section if non-empty.
 460 #
 461 sub opt_print {
 462     my ($output, $caption, $opttext) = @_;
 463     if (defined($opttext) && $opttext ne '' && $opttext !~ /^[ \t]+$/) {
 464         print $output
 465           "             <div class=\"mapi-section\">$caption</div>\n",
 466           "             <div>$opttext</div>\n";
 467     }
 468 }
 469
 470 #
 471 # Render parameter information as table.
 472 #
 473 sub render_parameters {
 474     my ($parameters) = @_;
 475     my $result = '';
 476     for my $parameter (@$parameters) {
 477         $result .= "<tr><td><i>$parameter->{name}</i></td><td>$parameter->{description}</td></tr>";
 478     }
 479     return $result;
 480 }
 481
 482 __END__
 483
 484 =head1 NAME
 485
 486 exdoc - Compiles API docs from Mono sources and HTML templates.
 487
 488 =head1 SYNOPSIS
 489
 490     exdoc [OPTIONS] [FILE...]
 491
 492 =head1 OPTIONS
 493
 494 =over 4
 495
 496 =item B<--help>
 497
 498 Print this help message.
 499
 500 =item B<--html> I<DIR>, B<-h> I<DIR>
 501
 502 Use I<DIR> as the input path for HTML sources.
 503
 504 =item B<--target> I<DIR>, B<-t> I<DIR>
 505
 506 Use I<DIR> as the target path for output.
 507
 508 =item B<--warnings>, B<-W>
 509
 510 Enable warnings about documentation errors.
 511
 512 =back
 513
 514 =head1 DESCRIPTION
 515
 516 Reads HTML templates and C sources, extracting documentation from the sources and splicing it into the templates.
 517
 518 =cut