Writer.pm.svn-base
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:8k
源码类别:

外挂编程

开发平台:

Windows_Unix

  1. package Writer;
  2. use strict;
  3. use warnings;
  4. use FindBin;
  5. use Extractor;
  6. use Utils;
  7. use CGI qw(escapeHTML);
  8. sub error {
  9. print STDERR "** Error: @_";
  10. }
  11. sub makeupText {
  12. my $text = shift;
  13. sub list {
  14. my $text = shift;
  15. my @list = split(/n+- /, $text);
  16. foreach (@list) {
  17. $_ = "<li>$_</li>";
  18. }
  19. $text = join("n", @list);
  20. $text =~ s/<li></li>//sg;
  21. return "<{ul}>$textn<{/ul}>";
  22. }
  23. sub preformatted {
  24. my ($attrs, $text) = @_;
  25. $attrs = '' if (!defined($attrs));
  26. # Remove auto-generated tags inside <pre> blocks.
  27. $text =~ s/n<{p}>//sg;
  28. $text =~ s/<{.*?}>//sg;
  29. return "<pre${attrs}>" . Utils::syntaxHighlight($text) . "</pre>";
  30. }
  31. $text =~ s/nn/n<{p}>nn/sg;
  32. $text =~ s/(</dd>)n<{p}>(n*<dt>)/$1$2/sg;
  33. $text =~ s/^`l$/<{ul}>/gm;
  34. $text =~ s/^`l`$/<{/ul}>/gm;
  35. $text =~ s/<{ul}>(.*?)<{/ul}>/&list($1)/gse;
  36. $text =~ s/(^| |n)(http://.*?)($| |n)/$1<a href="$2">$2</a>$3/gs;
  37. sub createFuncLink {
  38. my $func = shift;
  39. return '' if (!defined $func);
  40. my $name = $func;
  41. $name =~ s/()$//;
  42. if ($Extractor::functions{$name}) {
  43. my $file = $Extractor::functions{$name}{package};
  44. $file =~ s/::/--/g;
  45. return "<a href="$file.html#$name"><code>$func</code></a>";
  46. }
  47. return "<{code}>$func<{/code}>";
  48. }
  49. sub linkModule {
  50. my $text = shift;
  51. my $package = $text;
  52. $package =~ s/.pm$//;
  53. if ($Extractor::modules{$package}) {
  54. $package =~ s/::/--/g;
  55. $text = "<a href="${package}.html">$text</a>";
  56. }
  57. return $text;
  58. }
  59. sub processModuleTag {
  60. my ($module) = @_;
  61. if ($Extractor::modules{$module}) {
  62. my $link = $module;
  63. $link =~ s/::/--/g;
  64. return "<a href="$link.html"><code>$module</code></a>";
  65. } else {
  66. return "<code>$module</code>";
  67. }
  68. }
  69. sub processClassTag {
  70. return makeClassLink($_[0]);
  71. }
  72. # Links to modules/classes
  73. $text =~ s/([a-z0-9_:]+.pm)/&linkModule($1)/gie;
  74. $text =~ s/@MODULE((.*?))/&processModuleTag($1)/gse;
  75. $text =~ s/@CLASS((.*?))/&processClassTag($1)/gse;
  76. # Functions
  77. $text =~ s/($?[a-z0-9_:->]+())/&createFuncLink($1)/gie;
  78. # Variables
  79. $text =~ s/(^|n| )([$%@][a-z0-9_{'}:]+)/$1<{code}>$2<{/code}>/gis;
  80. $text =~ s/(<pre( .*?)?>(.*?)</pre>)/&preformatted($2, $3)/gse;
  81. $text =~ s/<{(.*?)}>/<$1>/gs;
  82. return $text;
  83. }
  84. sub makeClassLink {
  85. my ($type) = @_;
  86. if ($type && $Extractor::classes{$type}) {
  87. my $package = $Extractor::classes{$type};
  88. $package =~ s/::/--/g;
  89. return "<a href="${package}.html">" . escapeHTML($type) . "</a>";
  90. } else {
  91. return escapeHTML($type);
  92. }
  93. }
  94. sub parseDataType {
  95. my ($str) = @_;
  96. if ($str =~ /^(.+?)<(.+)>(.?)$/) {
  97. my ($a, $b, $c) = ($1, $2, $3);
  98. $str = makeClassLink($1) . '&lt;' . parseDataType($2) . '&gt;' . $3;
  99. return $str;
  100. } else {
  101. return makeClassLink($str);
  102. }
  103. }
  104. sub parseDeclarations {
  105. my ($decl) = @_;
  106. return "" if ($decl eq "");
  107. my @params;
  108. $decl =~ s/^(//;
  109. $decl =~ s/)$//;
  110. foreach my $param (split / +, +/, $decl) {
  111. # Check whether this parameter has a type definition
  112. if ($param =~ / /) {
  113. my ($type, $name) = split / /, $param, 2;
  114. $type = parseDataType($type);
  115. push @params, "<span class="type">$type</span> " . escapeHTML($name);
  116. } else {
  117. push @params, escapeHTML($param);
  118. }
  119. }
  120. return "(" . join(', ', @params) . ")";
  121. }
  122. sub compareSymbols {
  123. if ($a =~ /->new$/) {
  124. return -1;
  125. } elsif ($b =~ /->new$/) {
  126. return 1;
  127. } else {
  128. return $a cmp $b;
  129. }
  130. }
  131. sub writeModuleHTML {
  132. my $module = shift;
  133. if (! -d 'srcdoc' && !mkdir('srcdoc')) {
  134. error "Unable to create folder 'srcdoc'n";
  135. exit 1;
  136. }
  137. my $htmlFile = $module->{package};
  138. $htmlFile =~ s/::/--/g;
  139. $module->{htmlFile} = "$htmlFile.html";
  140. $htmlFile = "srcdoc/$htmlFile.html";
  141. my ($html, $f);
  142. if (!open($f, "< $FindBin::Bin/data/template.html")) {
  143. error "Unable to open template $FindBin::Bin/data/template.htmln";
  144. return 0;
  145. }
  146. local($/);
  147. $html = <$f>;
  148. close($f);
  149. if (!open(F, "> $htmlFile")) {
  150. error "Unable to open $htmlFile for writing.n";
  151. return 0;
  152. }
  153. my $description = makeupText($module->{desc});
  154. $html =~ s/@TITLE@/$module->{package} - $module->{name}/g;
  155. $html =~ s/@DESCRIPTION@/$description/;
  156. $html =~ s/@MODIFIED@/gmtime/ge;
  157. $html =~ s/@MODULE@/$module->{package}/g;
  158. sub writeFunctionIndex {
  159. my $module = shift;
  160. my $category = shift;
  161. my $text = '';
  162. my @symbols = keys %{$module->{categories}{$category}};
  163. foreach my $itemName (sort compareSymbols @symbols) {
  164. my $item = $module->{categories}{$category}{$itemName};
  165. my $name = $item->{name};
  166. my $abstract = $item->{abstract} ? "abstract&nbsp;" : "";
  167. my $returnType = parseDataType($item->{type} || "");
  168. my $decl = parseDeclarations($item->{param_declaration});
  169. $text .= "<tr onclick="location.href='#$item->{name}';">n" .
  170. " <td class="return-type">$abstract$returnType</td>n" .
  171. " <td class="func">" .
  172. "<a href="#$item->{name}">$name</a>" .
  173. "</td>n" .
  174. " <td class="decl">$decl</td>n" .
  175. "</tr>";
  176. }
  177. if ($text ne '') {
  178. my $title = ($category eq "") ? "Functions in this module" : $category;
  179. $text = "<p><table class="functionIndex">n" .
  180. "<tr><th colspan="3">$title</th></tr>" .
  181. "$textn" .
  182. "</table>n";
  183. }
  184. return $text;
  185. }
  186. sub writeFunctionIndices {
  187. my $module = shift;
  188. my $text = '';
  189. foreach my $category (sort (keys %{$module->{categories}})) {
  190. $text .= writeFunctionIndex($module, $category);
  191. }
  192. return $text;
  193. }
  194. $html =~ s/@FUNCINDEX@/&writeFunctionIndices($module)/ge;
  195. sub writeFunctionTable {
  196. my $module = shift;
  197. my $text = '';
  198. my $first = 1;
  199. foreach my $itemName (sort(keys %{$module->{items}})) {
  200. my $func = $module->{items}{$itemName};
  201. my $returnType = parseDataType($func->{type} || "");
  202. my $abstract = $func->{abstract} ? "abstract " : "";
  203. my $decl = parseDeclarations($func->{param_declaration});
  204. my $funcName = escapeHTML($func->{name});
  205. $text .= "<p><hr class="function_sep">" if (!$first);
  206. $first = 0;
  207. $text .= "<p>n<div class="function">" .
  208. "<a name="$funcName"></a>n" .
  209. "<h3>$funcName</h3>n" .
  210. "<dl>nt<dt class="decl">n" .
  211. "tt<span class="return-type">$abstract $returnType</span>" .
  212. (($returnType eq "") ? "" : " ") .
  213. "<strong>$funcName</strong>" .
  214. "$decln" .
  215. "t</dt>n" .
  216. "t<dd>n";
  217. my $write_bluelist = 0;
  218. if (@{$func->{params}} || $func->{returns} ne '' ||
  219.     $func->{requires} ne '' || $func->{ensures} ne '' ||
  220.     $func->{invariant} ne '' || $func->{throws} ne '') {
  221. $write_bluelist = 1;
  222. $text .= "tt<dl class="params_and_returns">n";
  223. }
  224. if (@{$func->{params}}) {
  225. $text .= "tt<dt class="params"><strong>Parameters:</strong></dt>n";
  226. foreach my $param (@{$func->{params}}) {
  227. my $desc = makeupText($param->[1]);
  228. $text .= "ttt<dd class="param"><code>" . $param->[0] . "</code> : $desc</dd>n";
  229. }
  230. }
  231. if ($func->{requires} ne '') {
  232. $text .= "tt<dt class="requires"><strong>Requires:</strong></dt>n" .
  233. "ttt<dd class="requires">" . $func->{requires} . "</dd>n";
  234. }
  235. if ($func->{ensures} ne '') {
  236. $text .= "tt<dt class="ensures"><strong>Ensures:</strong></dt>n" .
  237.  "ttt<dd class="ensures">" . makeupText($func->{ensures})
  238.  . "</dd>n";
  239. }
  240. if ($func->{returns} ne '') {
  241. $text .= "tt<dt class="returns"><strong>Returns:</strong></dt>n" .
  242. "ttt<dd class="returns">" . $func->{returns} . "</dd>n";
  243. }
  244. if ($func->{invariant} ne '') {
  245. $text .= "tt<dt class="invariant"><strong>Invariant:</strong></dt>n" .
  246.  "ttt<dd class="invariant">" . makeupText($func->{invariant})
  247.  . "</dd>n";
  248. }
  249. if ($func->{throws} ne '') {
  250. $text .= "tt<dt class="throws"><strong>Throws:</strong></dt>n" .
  251.  "ttt<dd class="throws">" . makeupText($func->{throws})
  252.  . "</dd>n";
  253. }
  254. if ($write_bluelist) {
  255. $text .= "tt</dl><p>nn";
  256. }
  257. $text .= "tt<div class="desc">" . makeupText($func->{desc}) . "</div>n";
  258. if ($func->{example} ne '') {
  259. my $example = $func->{example};
  260. $text .= "ntt<dl class="example">n" .
  261. "ttt<dt><strong>Example:</strong></dt>n" .
  262. "ttt<dd><pre>";
  263. $text .= Utils::syntaxHighlight($example);
  264. $text .= "</pre></dd>ntt</dl>n";
  265. }
  266. $text .= "t</dd>n</dl>n</div>nnn";
  267. }
  268. if ($text ne '') {
  269. $text = "<p><hr class="details_sep">nn" .
  270. "<h2>Details</h2>n" .
  271. "<div class="details">nnn" .
  272. "$textnnn" .
  273. "</div>";
  274. }
  275. return $text;
  276. }
  277. $html =~ s/@FUNCTABLE@/&writeFunctionTable($module)/ge;
  278. print F $html;
  279. close(F);
  280. }
  281. 1;