writehtml.pl

   1 #!/usr/bin/perl
   2 # vim: set noet:
   3 use strict;
   4 use warnings;
   5
   6 use YAML;
   7
   8 # this may also appear as something like openc2e/mirror/trunk/writehtml.pl 43539 2005-08-15T00:44:28.013173Z bdonlan (between dollar-sign Id dollar-sign)
   9 my $id = '$Id$';
  10
  11 sub captext ($);
  12
  13 BEGIN {
  14         eval {
  15                 require Text::Capitalize;
  16                 import Text::Capitalize;
  17         };
  18         if ($@) {
  19                 *captext = sub ($) {
  20                         my $t = shift;
  21                         $t =~ s/^([a-z])/uc $1/e;
  22                         return $t;
  23                 };
  24         } else {
  25                 *captext = sub ($) {
  26                         return capitalize_title($_[0]);
  27                 };
  28         }
  29 }
  30
  31 sub esc ($) {
  32         my $t = shift;
  33         $t =~ s/\W/_/g;
  34         return $t;
  35 }
  36
  37 my $data = YAML::LoadFile($ARGV[0]);
  38
  39 # XXX
  40 $data = { ops => $data->{variants}{c3} };
  41
  42 my %catsort;
  43 foreach my $key (sort keys %{$data->{ops}}) {
  44         $data->{ops}{$key}{key} = $key;
  45         push @{$catsort{$data->{ops}{$key}{category}}}, $data->{ops}{$key};
  46 }
  47
  48 foreach my $key (keys %catsort) {
  49         $catsort{$key} = [
  50                 map { $_->[0] }
  51                 sort { $a->[1] cmp $b->[1] }
  52                 map { [ $_, $_->{name} ] }
  53                 @{$catsort{$key}}
  54         ];
  55 }
  56
  57 my @catl = map { { name => captext($_), ents => $catsort{$_}, anchor => esc($_) } } sort keys %catsort;
  58 my $time = scalar gmtime;
  59 print <<END;
  60 <?xml version="1.0" encoding="UTF-8" standalone="no" ?>
  61 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd">
  62 <html>
  63         <head>
  64                 <title>CAOS command reference - openc2e</title>
  65                 <link rel="stylesheet" type="text/css" href="docs.css" />
  66         </head>
  67         <body>
  68                 <h1>CAOS command reference - openc2e dev build</h1>
  69                 <i>Last updated $time (UTC)</i>
  70 END
  71
  72
  73 my %st_insert = (
  74         todo => ['st_todo', 'This command is not yet implemented.', 'stubs', 0],
  75         probablyok => ['st_maybe', 'This command probably works, but it has not been annotated with its status.', 'unknown', 0],
  76         maybe => ['st_maybe', 'This command is believed to work, but has not yet been thoroughly tested.', 'untested', 0],
  77         broken => ['st_todo', 'This command is partially implemented but missing large amounts of functionality, or is nonconformant in some vital way.', 'broken', 0],
  78         ok => ['st_ok', 'This command works properly.', 'done', 0],
  79 );
  80
  81 $st_insert{stub} = $st_insert{todo};
  82 $st_insert{done} = $st_insert{ok};
  83
  84 foreach my $op (values %{$data->{ops}}) {
  85         $st_insert{$op->{status}}[3]++;
  86 }
  87
  88 my @cstat;
  89 foreach my $clas (qw(ok broken maybe probablyok todo)) {
  90         if ($st_insert{$clas}[3] != 0) {
  91                 push @cstat, "$st_insert{$clas}[3] $st_insert{$clas}[2]";
  92         }
  93 }
  94
  95 print '<div id="summary">';
  96 print scalar keys %{$data->{ops}}, " commands in total; ";
  97 print join ", ", @cstat;
  98 print ".</div>";
  99 print '<div id="index"><ul>';
 100 foreach my $c (@catl) {
 101         print "<li><a href=\"#c_", $c->{anchor}, "\">", $c->{name}, "</a></li>\n";
 102 }
 103 print "</ul></div>\n";
 104
 105
 106
 107
 108
 109 print <<END;
 110         <div id="sidebar">
 111         <h6>Commands</h6>
 112         <ul>
 113 END
 114
 115 foreach my $key (grep { /^c_/ } sort keys %{$data->{ops}}) {
 116         my $class = $st_insert{$data->{ops}{$key}{status}}[0] || 'st_wtf';
 117         print qq{<li><a class="$class" href="#k_$key">$data->{ops}{$key}{name}</a></li>};
 118 }
 119
 120 print <<END;
 121         </ul><hr />
 122         <h6>Expressions</h6>
 123         <ul>
 124 END
 125
 126 foreach my $key (grep { /^v_/ } sort keys %{$data->{ops}}) {
 127         my $class = $st_insert{$data->{ops}{$key}{status}}[0] || 'st_wtf';
 128         print qq{<li><a class="$class" href="#k_$key">$data->{ops}{$key}{name}</a></li>};
 129 }
 130
 131 print '</ul></div><div id="content">';
 132 foreach my $cat (@catl) {
 133         print qq{<div class="category" id="c_$cat->{anchor}">\n};
 134         print qq{<h2>$cat->{name}</h2><hr/>\n};
 135         foreach my $op (@{$cat->{ents}}) {
 136                 print qq{<div class="command" id="k_$op->{key}">\n};
 137                 print qq{<div class="header">\n};
 138                 print qq{<span class="cmdname">$op->{name}</span>\n};
 139                 print qq{<span class="cmdtype">($op->{type})</span>\n};
 140                 foreach my $arg (@{$op->{arguments}}) {
 141                         print qq{<span class="argname">$arg->{name}</span>\n};
 142                         print qq{<span class="argtype">($arg->{type})</span>\n};
 143                 }
 144                 print qq{</div><div class="description">};
 145                 unless (defined $op->{description}) {
 146                         print qq{<div class="nodocs">This command is currently undocumented.</div>\n};
 147                 } else {
 148                         print qq{<div class="docs">$op->{description}</div>\n};
 149                 }
 150                 print qq{</div><div class="status">};
 151                 if (defined $st_insert{$op->{status}}[0]) {
 152                         print qq{<div class="$st_insert{$op->{status}}[0]">};
 153                         print $st_insert{$op->{status}}[1];
 154                         print qq{</div>};
 155                 } else {
 156                         print qq{<div class="st_wtf">This command has an unknown status tag of: $op->{status}.};
 157                         print qq{Please beat whoever set that status with a shovel or some other heavy object.};
 158                         print qq{</div>};
 159                 }
 160                 print qq{</div>};
 161                 print qq{<div class="administrivia"><ul>};
 162                 print qq{<li>Implemented in: $op->{filename}</li>};
 163                 print qq{<li>Implementation functions (may be wrong): $op->{implementation}</li>};
 164                 if ($op->{pragma}) {
 165                         print qq{<li>Pragmas:<ul>};
 166                         foreach my $pk (sort keys %{$op->{pragma}}) {
 167                                 print qq{<li>$pk =&gt; $op->{pragma}{$pk}</li>};
 168                         }
 169                         print qq{</ul></li>};
 170                 }
 171                 print qq{</ul></div>};
 172                 print qq{</div>};
 173         }
 174         print qq{</div>};
 175 }
 176
 177 print qq{</div></body></html>};
 178
 179
 180
 181
 182
 183
 184