w3mdoc.pl (1807B)
1 #!/usr/local/bin/perl 2 3 package w3mdoc; 4 5 sub CHECK { 6 my($a, @b) = @_; 7 for(@b) { 8 defined($a->{$_}) || die("\"$a->{id}.$_\" is not defined.\n"); 9 } 10 } 11 12 sub DEF { 13 my($a, $b, $c) = @_; 14 15 if (! defined($data->{$a})) { 16 $data->{$a} = bless { id => $a }; 17 } 18 $data->{$a}{$b} = $c; 19 } 20 21 sub SUB { 22 local($_) = @_; 23 my($a, $b); 24 25 if (/^\@(\w+)\.(\w+)\@$/) { 26 ($a, $b) = ($1, $2); 27 defined($data->{$a}) || die("\"$a.$b\" is not defined.\n"); 28 $data->{$a}->CHECK($b); 29 return $data->{$a}{$b}; 30 } 31 if (/^\@(\w+)\((\w+)\)\@$/) { 32 ($a, $b) = ($1, $2); 33 defined(&{$a}) || die("\"$a()\" is not defined.\n"); 34 defined($data->{$b}) || die("\"$a($b)\" is not defined.\n"); 35 return $data->{$b}->$a(); 36 } 37 return '@'; 38 } 39 40 package main; 41 42 @ARGV || unshift(@ARGV, "-"); 43 while(@ARGV) { 44 $file = shift @ARGV; 45 &make_doc($file); 46 } 47 48 sub make_doc { 49 my($file) = @_; 50 my($in_def, $in_code, $code, $a, $b); 51 local(*F); 52 local($_); 53 54 open(F, $file) || die("$file: $!\n"); 55 $in_def = 0; 56 $in_code = 0; 57 while(<F>) { 58 if ($in_def) { 59 if (/^\@end/) { 60 $in_def = 0; 61 next; 62 } 63 s/^\s+//; 64 s/^(\w+)\.(\w+)// || next; 65 ($a, $b) = ($1, $2); 66 s/^\s+//; 67 s/\s+$//; 68 &w3mdoc::DEF($a, $b, $_); 69 next; 70 } 71 if ($in_code) { 72 if (/^\@end/) { 73 eval "package w3mdoc; $code"; 74 $in_code = 0; 75 next; 76 } 77 $code .= $_; 78 next; 79 } 80 if (/^\@define/) { 81 $in_def = 1; 82 next; 83 } 84 if (/^\@code/) { 85 $in_code = 1; 86 $code = ""; 87 next; 88 } 89 if (s/^\@include\s+//) { 90 s/\s+$//; 91 &make_doc($_); 92 next; 93 } 94 if (/^\@/) { 95 die("unknown command: $_"); 96 } 97 s/(\\@|\@(\w+(\.\w+|\(\w+\)))\@)/&w3mdoc::SUB($1)/eg; 98 print; 99 } 100 close(F); 101 } 102