home *** CD-ROM | disk | FTP | other *** search
/ HTML - Publishing on the Internet / html_cdrom.iso / tools / html / linux / check / htmlchek.pl < prev    next >
Perl Script  |  1995-02-22  |  75KB  |  1,505 lines
  1. #!/usr/local/bin/perl
  2. #htmlchek.pl: Syntactically checks HTML files for a number of possible errors.
  3. #
  4. # Typical use:
  5. #
  6. #   perl htmlchek.pl [options] infile.html > outfile.check
  7. #
  8. #   Where options have the form "option=value", and are detailed in the
  9. # documentation.
  10. #
  11. #   This program is a port to perl of the original htmlchek.awk (the port was
  12. # fairly mechanical, so programming style and efficency may not be high).
  13. #
  14. # Copyright H. Churchyard 1994, 1995 -- freely redistributable.
  15. #
  16. #  Version 2.0 11/17/94 -- Ported from awk to perl, with some help from Charlie
  17. # Stosser <charless@sco.com>.
  18. #
  19. #  Version 4.1 2/20/95 -- Many enhancements.
  20. #
  21. eval "exec /usr/local/bin/perl -S $0 $*"
  22.     if $running_under_some_shell; # This emulates #! processing on NIH machines
  23. #
  24. #List of known HTML tagwords, divided into pairing tags, <X>...</X>, and
  25. #non-pairing tags -- those where <X> occurs without a following </X>.
  26. #Pairing tags are further classified into list tags, and those tags which
  27. #do not self-nest, etc.
  28. #
  29. #Non-pairing:
  30. #
  31. $unpair{'!--'} = 1; $unpair{'!DOCTYPE'} = 1; $unpair{'BASE'} = 1;
  32. $unpair{'BR'} = 1; $unpair{'COMMENT'} = 1; $unpair{'HR'} = 1;
  33. $unpair{'IMG'} = 1; $unpair{'INPUT'} = 1; $unpair{'ISINDEX'} = 1;
  34. $unpair{'LINK'} = 1; $unpair{'META'} = 1; $unpair{'NEXTID'} = 1;
  35. #
  36. #Optionally-pairing:
  37. #
  38. $canpair{'DD'} = 1; $canpair{'DT'} = 1; $canpair{'LI'} = 1;
  39. $canpair{'OPTION'} = 1; $canpair{'P'} = 1; $canpair{'PLAINTEXT'} = 1;
  40. #
  41. #Pairing:
  42. #
  43. $pair{'A'} = 1; $pair{'ADDRESS'} = 1; $pair{'B'} = 1; $pair{'BLOCKQUOTE'} = 1;
  44. $pair{'BODY'} = 1; $pair{'CITE'} = 1; $pair{'CODE'} = 1; $pair{'DFN'} = 1;
  45. $pair{'DIR'} = 1; $pair{'DL'} = 1; $pair{'EM'} = 1; $pair{'FORM'} = 1;
  46. $pair{'H1'} = 1; $pair{'H2'} = 1; $pair{'H3'} = 1; $pair{'H4'} = 1;
  47. $pair{'H5'} = 1; $pair{'H6'} = 1; $pair{'HEAD'} = 1; $pair{'HTML'} = 1;
  48. $pair{'I'} = 1; $pair{'KBD'} = 1; $pair{'KEY'} = 1; $pair{'LISTING'} = 1;
  49. $pair{'MENU'} = 1; $pair{'OL'} = 1; $pair{'PRE'} = 1; $pair{'S'} = 1;
  50. $pair{'SAMP'} = 1; $pair{'SELECT'} = 1; $pair{'STRONG'} = 1;
  51. $pair{'TEXTAREA'} = 1; $pair{'TITLE'} = 1; $pair{'TT'} = 1; $pair{'U'} = 1;
  52. $pair{'UL'} = 1; $pair{'VAR'} = 1; $pair{'XMP'} = 1;
  53. #
  54. # The union of the set of tags in ``pair'' with the sets of tags in ``unpair''
  55. # and ``canpair'' is the set of all tags known to this program.
  56. #
  57. #Deprecated:
  58. #
  59. $deprec{'COMMENT'} = 1; $deprec{'LISTING'} = 1; $deprec{'PLAINTEXT'} = 1;
  60. $deprec{'XMP'} = 1;
  61. #
  62. #These tags are proposed and/or used, but are are not part of the HTML 1.24 DTD:
  63. #
  64. $nonstd{'DFN'} = 1; $nonstd{'KEY'} = 1; $nonstd{'U'} = 1; $nonstd{'S'} = 1;
  65. #
  66. #Allowed in the <head>...</head> element:
  67. #
  68. $inhead{'ISINDEX'} = 1; $inhead{'HEAD'} = 1; $inhead{'!--'} = 1;
  69. #
  70. #.. and also not allowed in <body>...</body>:
  71. #
  72. $headonly{'BASE'} = 1; $headonly{'LINK'} = 1; $headonly{'META'} = 1;
  73. $headonly{'NEXTID'} = 1; $headonly{'TITLE'} = 1;
  74. #
  75. #Allowed only in context of form -- OPTION only in context of SELECT:
  76. #
  77. $formonly{'INPUT'} = 1; $formonly{'SELECT'} = 1; $formonly{'TEXTAREA'} = 1;
  78. #
  79. #Lists -- all <LI> must be first order daughter of these and vice versa:
  80. #
  81. $list{'DIR'} = 1; $list{'MENU'} = 1; $list{'OL'} = 1; $list{'UL'} = 1;
  82. #
  83. #Lists that do not involve <LI> -- this is almost only used for the "Maximum
  84. #depth of list embedding" diagnostic:
  85. #
  86. $nonlilist{'DL'} = 1;
  87. #
  88. #Lists whose <LI> can only contain low-level markup.
  89. #
  90. $lowlvlist{'DIR'} = 1; $lowlvlist{'MENU'} = 1;
  91. #
  92. #These elements can't contain _any_other_ tags within them.
  93. #
  94. $pcdata{'TITLE'} = 1; $pcdata{'OPTION'} = 1; $pcdata{'TEXTAREA'} = 1;
  95. #
  96. #These tags require the presence of some option -- A is checked separately:
  97. #
  98. $rqopt{'BASE', 'HREF'} = 1; $rqopt{'IMG', 'SRC'} = 1;
  99. $rqopt{'LINK', 'HREF'} = 1; $rqopt{'META', 'CONTENT'} = 1;
  100. $rqopt{'NEXTID', 'N'} = 1; $rqopt{'SELECT', 'NAME'} = 1;
  101. $rqopt{'TEXTAREA', 'NAME'} = 1; $rqopt{'TEXTAREA', 'ROWS'} = 1;
  102. $rqopt{'TEXTAREA', 'COLS'} = 1;
  103. #
  104. #Allowed options; if $opt{'TAG','OPTION'}=1, then that option does not require
  105. #a value.
  106. #
  107. $opt{'A','HREF'} = 2; $opt{'A','METHODS'} = 2; $opt{'A','NAME'} = 2;
  108. $opt{'A','REL'} = 2; $opt{'A','REV'} = 2; $opt{'A','TITLE'} = 2;
  109. $opt{'A','URN'} = 2; $opt{'BASE','HREF'} = 2; $opt{'DIR','COMPACT'} = 1;
  110. $opt{'DL','COMPACT'} = 1; $opt{'FORM','ACTION'} = 2;
  111. $opt{'FORM','ENCTYPE'} = 2; $opt{'FORM','METHOD'} = 1;
  112. $opt{'HTML','VERSION'} = 2; $opt{'IMG','ALIGN'} = 2; $opt{'IMG','ALT'} = 2;
  113. $opt{'IMG','ISMAP'} = 1; $opt{'IMG','SRC'} = 2; $opt{'INPUT','ALIGN'} = 2;
  114. $opt{'INPUT','CHECKED'} = 1; $opt{'INPUT','MAXLENGTH'} = 2;
  115. $opt{'INPUT','NAME'} = 2; $opt{'INPUT','SIZE'} = 2; $opt{'INPUT','SRC'} = 2;
  116. $opt{'INPUT','TYPE'} = 2; $opt{'INPUT','VALUE'} = 2; $opt{'LINK','HREF'} = 2;
  117. $opt{'LINK','METHODS'} = 2; $opt{'LINK','REL'} = 2; $opt{'LINK','REV'} = 2;
  118. $opt{'LINK','TITLE'} = 2; $opt{'LINK','URN'} = 2; $opt{'MENU','COMPACT'} = 1;
  119. $opt{'META','CONTENT'} = 2; $opt{'META','HTTP-EQUIV'} = 2;
  120. $opt{'META','NAME'} = 2; $opt{'NEXTID','N'} = 2; $opt{'OL','COMPACT'} = 1;
  121. $opt{'OPTION','SELECTED'} = 1; $opt{'OPTION','VALUE'} = 2;
  122. $opt{'PRE','WIDTH'} = 2; $opt{'SELECT','MULTIPLE'} = 1;
  123. $opt{'SELECT','NAME'} = 2; $opt{'SELECT','SIZE'} = 2;
  124. $opt{'TEXTAREA','COLS'} = 2; $opt{'TEXTAREA','NAME'} = 2;
  125. $opt{'TEXTAREA','ROWS'} = 2; $opt{'UL','COMPACT'} = 1;
  126. #
  127. #These elements -- and also <LI> in MENU or DIR -- can only contain low-level
  128. #markup (ADDRESS is hard-wired separately because it can contain <P>):
  129. #
  130. $text{'DT'} = 1; $text{'H1'} = 1; $text{'H2'} = 1; $text{'H3'} = 1;
  131. $text{'H4'} = 1; $text{'H5'} = 1; $text{'H6'} = 1; $text{'PRE'} = 1;
  132. #
  133. #These low-level markup elements can only contain other low-level mark-up.
  134. #Special coding to allow headings in <A> and <HR> in <PRE>.
  135. #
  136. $lowlv{'A'} = 1; $lowlv{'B'} = 1; $lowlv{'CITE'} = 1; $lowlv{'CODE'} = 1;
  137. $lowlv{'DFN'} = 1; $lowlv{'EM'} = 1; $lowlv{'I'} = 1; $lowlv{'KBD'} = 1;
  138. $lowlv{'S'} = 1; $lowlv{'SAMP'} = 1; $lowlv{'STRONG'} = 1; $lowlv{'TT'} = 1;
  139. $lowlv{'U'} = 1; $lowlv{'VAR'} = 1;
  140. #
  141. #Non-pairing low-level markup tags:
  142. #
  143. $lwlvunp{'BR'} = 1; $lwlvunp{'IMG'} = 1; $lwlvunp{'!--'} = 1;
  144. #
  145. #Pairing but non-self-nesting tags -- i.e. one occurrence of <x>...</x> can
  146. #never occur inside another occurrence of <x>...</x>, no matter how many
  147. #intervening levels of embedding.  I'm actually stricter than the standard
  148. #here, since such self-nesting is almost certain to be by mistake, and this
  149. #is a powerful error-detecting technique.
  150. #
  151. #In official specification:
  152. $nonnest{'A'} = 1; $nonnest{'ADDRESS'} = 1; $nonnest{'FORM'} = 1;
  153. $nonnest{'DIR'} = 1; $nonnest{'H1'} = 1; $nonnest{'H2'} = 1;
  154. $nonnest{'H3'} = 1; $nonnest{'H4'} = 1; $nonnest{'H5'} = 1; $nonnest{'H6'} = 1;
  155. $nonnest{'HTML'} = 1; $nonnest{'MENU'} = 1; $nonnest{'PRE'} = 1;
  156. $nonnest{'SELECT'} = 1; $nonnest{'TEXTAREA'} = 1; $nonnest{'TITLE'} = 1;
  157. #Added by me:
  158. $nonnest{'B'} = 1; $nonnest{'CITE'} = 1; $nonnest{'CODE'} = 1;
  159. $nonnest{'DFN'} = 1; $nonnest{'EM'} = 1; $nonnest{'I'} = 1;
  160. $nonnest{'KBD'} = 1; $nonnest{'LISTING'} = 1; $nonnest{'S'} = 1;
  161. $nonnest{'SAMP'} = 1; $nonnest{'STRONG'} = 1; $nonnest{'TT'} = 1;
  162. $nonnest{'U'} = 1; $nonnest{'VAR'} = 1; $nonnest{'XMP'} = 1;
  163. #
  164. #$nonnest{'BODY'}=1;$nonnest{'HEAD'}=1; #Separate checks for these
  165. #Document-enclosing tag:
  166. $html{'HTML'} = 1;
  167. #Default declarations, to keep -w option happy:
  168. $X = 0; $append = 0; $arena = ''; $configfile = '';
  169. $clo[++$X] = 'append'; $clo[++$X] = 'arena'; $clo[++$X] = 'configfile';
  170.         $deprecated = ''; $dirprefix = ''; $html3 = '';
  171. $clo[++$X] = 'deprecated'; $clo[++$X] = 'dirprefix'; $clo[++$X] = 'html3';
  172.         $htmlplus = ''; $loosepair = '';
  173. $clo[++$X] = 'htmlplus'; $clo[++$X] = 'loosepair';
  174.         $lowlevelnonpair = ''; $lowlevelpair = '';
  175. $clo[++$X] = 'lowlevelnonpair'; $clo[++$X] = 'lowlevelpair';
  176.         $netscape = ''; $nonblock = ''; $nonpair = '';
  177. $clo[++$X] = 'netscape'; $clo[++$X] = 'nonblock'; $clo[++$X] = 'nonpair';
  178.         $nonrecurpair = ''; $nowswarn = 0; $refsfile = '';
  179. $clo[++$X] = 'nonrecurpair'; $clo[++$X] = 'nowswarn'; $clo[++$X] = 'refsfile';
  180.         $reqopts = ''; $strictpair = ''; $sugar = 0;
  181. $clo[++$X] = 'reqopts'; $clo[++$X] = 'strictpair'; $clo[++$X] = 'sugar';
  182.         $tagopts = ''; $usebase = 0; $dlstrict = 0;
  183. $clo[++$X] = 'tagopts'; $clo[++$X] = 'usebase'; $clo[++$X] = 'dlstrict';
  184.         $novalopts = ''; $xref = 0; $subtract= '';
  185. $clo[++$X] = 'novalopts'; $clo[++$X] = 'xref'; $clo[++$X] = 'subtract';
  186.         $map = 0; $metachar = 0; $nogtwarn = 0;
  187. $clo[++$X] = 'map'; $clo[++$X] = 'metachar'; $clo[++$X] = 'nogtwarn';
  188.         $cf = ''; $lf = ''; $listfile = ''; $inline = 0;
  189. $clo[++$X] = 'cf'; $clo[++$X] = 'lf'; $clo[++$X] = 'listfile';
  190. $clo[++$X] = 'inline';
  191. $clostr = (join('=|',@clo) . '=');
  192. #
  193. #process any FOO=bar switches
  194. eval '$'.$1.'$2;' while $ARGV[0] =~ /^($clostr)(.*)/o && shift;
  195. $[ = 1;                 # set array base to 1
  196. $, = ' ';               # set output field separator
  197. $\ = "\n";              # set output record separator
  198. foreach $X (@ARGV) {
  199.     if ($X =~ /^[^=]+=/) {
  200.         print STDERR "Apparent misspelled or badly-placed command-line option $&";
  201.         print STDERR "Attempting to continue anyway...";}}
  202. #List file
  203. $stuperlRS = $/;
  204. if ($lf) {
  205.     if ($listfile) {
  206.         die 'Error: both lf= and listfile= specified';}
  207.     else {
  208.         $listfile = $lf;}}
  209. if ($listfile) {
  210.     $args = 0;
  211.     if (!(open(LSF,('<'.$listfile)))) {
  212.         die 'Error opening list file!';}
  213.     while (<LSF>) {
  214.         if ($_ =~ /$stuperlRS$/o) {chop;}
  215.         ++$args;
  216.         $_ =~ s/[ \t]+$//;
  217.         $_ =~ s/^[ \t]+//;
  218.         $ARGV[$args] = $_;}
  219.     if ($. > 0) {
  220.         close(LSF);
  221.         $#ARGV = $args;}
  222.     else {die 'Empty list file!';}}
  223. #
  224. $xxllm = '(which should only include low-level markup)';
  225. &initscalrs();
  226. #Configuration file
  227. if ($cf) {
  228.     if ($configfile) {
  229.     die 'Error: both cf= and configfile= specified';}
  230.     else {
  231.     $configfile = $cf;}}
  232. if ($configfile) {
  233.     if (!(open(CFG,('<'.$configfile)))) {
  234.         die 'Error opening configuration file!';}
  235.     while (<CFG>) {
  236.          if ($_ =~ /$stuperlRS$/o) {chop;}
  237.          $_ =~ s/[ \t]+//g;
  238.          $X = (@cfgarr = split(/=/, $_, 3));
  239.          if ($X == 2) {
  240.              &setoption($cfgarr[1], $cfgarr[2]);}
  241.          else {
  242.              if ($X > 2) {
  243.                  print STDERR 'Invalid line in config file:', $_;}}}
  244.     if ($. > 0) {close(CFG);}
  245.     else {die 'Empty configuration file!';}}
  246. #
  247. # HTML 3.0 extensions according to Jan. 19 1995 Arena document:
  248. #
  249. #idlgs["TAG"]=1 means that "ID", "LANG", and "CLASS" are allowed options.
  250. #
  251. $h3 = 0; #controls LH allowed in lists
  252. if ((($arena) || ($html3) || ($htmlplus)) && (!(($html3 eq 'off') ||
  253.   ($htmlplus eq 'off') || ($arena eq 'off')))) {
  254.     $pair{'ABBREV'} = 1; $pair{'ABOVE'} = 1; $pair{'ACRONYM'} = 1;
  255.     $pair{'ARRAY'} = 1; $pair{'AU'} = 1; $pair{'BELOW'} = 1; $pair{'BIG'} = 1;
  256.     $pair{'BOX'} = 1; $pair{'BQ'} = 1; $pair{'CAPTION'} = 1; $pair{'DFN'} = 1;
  257.     $pair{'FIG'} = 1; $pair{'FN'} = 1; $pair{'LANG'} = 1; $pair{'MATH'} = 1;
  258.     $pair{'NOTE'} = 1; $pair{'PERSON'} = 1; $pair{'Q'} = 1; $pair{'ROOT'} = 1;
  259.     $pair{'S'} = 1; $pair{'SMALL'} = 1; $pair{'SUB'} = 1; $pair{'SUP'} = 1;
  260.     $pair{'TABLE'} = 1; $pair{'U'} = 1; $unpair{'ATOP'} = 1;
  261.     $unpair{'LEFT'} = 1; $unpair{'OVER'} = 1; $unpair{'OVERLAY'} = 1;
  262.     $unpair{'RIGHT'} = 1; $unpair{'TAB'} = 1; $canpair{'AROW'} = 1;
  263.     $canpair{'ITEM'} = 1; $canpair{'LH'} = 1; $canpair{'TD'} = 1;
  264.     $canpair{'TH'} = 1; $canpair{'TR'} = 1; $lowlv{'ABBREV'} = 1;
  265.     $lowlv{'ACRONYM'} = 1; $lowlv{'AU'} = 1; $lowlv{'BIG'} = 1;
  266.     $lowlv{'LANG'} = 1; $lowlv{'PERSON'} = 1; $lowlv{'Q'} = 1;
  267.     $lowlv{'SMALL'} = 1; $lowlv{'SUB'} = 1; $lowlv{'SUP'} = 1;
  268.     $lwlvunp{'TAB'} = 1; $text{'LH'} = 1; $text{'CAPTION'} = 1; $idlgs{'A'} = 1;
  269.     $idlgs{'ABBREV'} = 1; $idlgs{'ACRONYM'} = 1; $idlgs{'ADDRESS'} = 1;
  270.     $idlgs{'AU'} = 1; $idlgs{'B'} = 1; $idlgs{'BIG'} = 1;
  271.     $idlgs{'BLOCKQUOTE'} = 1; $idlgs{'BODY'} = 1; $idlgs{'BQ'} = 1;
  272.     $idlgs{'BR'} = 1; $idlgs{'CAPTION'} = 1; $idlgs{'CITE'} = 1;
  273.     $idlgs{'CODE'} = 1; $idlgs{'DD'} = 1; $idlgs{'DFN'} = 1; $idlgs{'DL'} = 1;
  274.     $idlgs{'DT'} = 1; $idlgs{'EM'} = 1; $idlgs{'FIG'} = 1; $idlgs{'FN'} = 1;
  275.     $idlgs{'H1'} = 1; $idlgs{'H2'} = 1; $idlgs{'H3'} = 1; $idlgs{'H4'} = 1;
  276.     $idlgs{'H5'} = 1; $idlgs{'H6'} = 1; $idlgs{'I'} = 1; $idlgs{'IMG'} = 1;
  277.     $idlgs{'INPUT'} = 1; $idlgs{'KBD'} = 1; $idlgs{'LANG'} = 1;
  278.     $idlgs{'LH'} = 1; $idlgs{'LI'} = 1; $idlgs{'NOTE'} = 1; $idlgs{'OL'} = 1;
  279.     $idlgs{'OPTION'} = 1; $idlgs{'P'} = 1; $idlgs{'PERSON'} = 1;
  280.     $idlgs{'PRE'} = 1; $idlgs{'Q'} = 1; $idlgs{'S'} = 1; $idlgs{'SAMP'} = 1;
  281.     $idlgs{'SELECT'} = 1; $idlgs{'SMALL'} = 1; $idlgs{'STRONG'} = 1;
  282.     $idlgs{'SUB'} = 1; $idlgs{'SUP'} = 1; $idlgs{'TABLE'} = 1; $idlgs{'TD'} = 1;
  283.     $idlgs{'TEXTAREA'} = 1; $idlgs{'TH'} = 1; $idlgs{'TR'} = 1;
  284.     $idlgs{'TT'} = 1; $idlgs{'U'} = 1; $idlgs{'UL'} = 1; $idlgs{'VAR'} = 1;
  285.     $opt{'A','BASE'} = 2; $opt{'A','MD'} = 2; $opt{'A','SHAPE'} = 2;
  286.     $opt{'ABOVE','SYMBOL'} = 2; $opt{'ARRAY','COLDEF'} = 2;
  287.     $opt{'ARRAY','DELIM'} = 2; $opt{'ARRAY','LABELS'} = 1;
  288.     $opt{'BASE','ID'} = 2; $opt{'BELOW','SYMBOL'} = 2;
  289.     $opt{'BODY','POSITION'} = 2; $opt{'BOX','DELIM'} = 2;
  290.     $opt{'BOX','SIZE'} = 2; $opt{'BR','ALIGN'} = 2;
  291.     $opt{'CAPTION','ALIGN'} = 2; $opt{'FIG','ALIGN'} = 2;
  292.     $opt{'FIG','BASE'} = 2; $opt{'FIG','HEIGHT'} = 2;
  293.     $opt{'FIG','HSPACE'} = 2; $opt{'FIG','ISMAP'} = 1; $opt{'FIG','MD'} = 2;
  294.     $opt{'FIG','SRC'} = 2; $opt{'FIG','UNITS'} = 2; $opt{'FIG','URN'} = 2;
  295.     $opt{'FIG','VSPACE'} = 2; $opt{'FIG','WIDTH'} = 2; $opt{'H1','ALIGN'} = 2;
  296.     $opt{'H1','NOFOLD'} = 1; $opt{'H1','NOWRAP'} = 1; $opt{'H2','ALIGN'} = 2;
  297.     $opt{'H2','NOFOLD'} = 1; $opt{'H2','NOWRAP'} = 1; $opt{'H3','ALIGN'} = 2;
  298.     $opt{'H3','NOFOLD'} = 1; $opt{'H3','NOWRAP'} = 1; $opt{'H4','ALIGN'} = 2;
  299.     $opt{'H4','NOFOLD'} = 1; $opt{'H4','NOWRAP'} = 1; $opt{'H5','ALIGN'} = 2;
  300.     $opt{'H5','NOFOLD'} = 1; $opt{'H5','NOWRAP'} = 1; $opt{'H6','ALIGN'} = 2;
  301.     $opt{'H6','NOFOLD'} = 1; $opt{'H6','NOWRAP'} = 1; $opt{'HR','ALIGN'} = 2;
  302.     $opt{'HR','BASE'} = 2; $opt{'HR','MD'} = 2; $opt{'HR','SRC'} = 2;
  303.     $opt{'HR','URN'} = 2; $opt{'HR','WIDTH'} = 2; $opt{'IMG','BASE'} = 2;
  304.     $opt{'IMG','HEIGHT'} = 2; $opt{'IMG','MD'} = 2; $opt{'IMG','UNITS'} = 2;
  305.     $opt{'IMG','URN'} = 2; $opt{'IMG','WIDTH'} = 2; $opt{'INPUT','BASE'} = 2;
  306.     $opt{'INPUT','MD'} = 2; $opt{'INPUT','URN'} = 2;
  307.     $opt{'ISINDEX','HREF'} = 2; $opt{'ISINDEX','PROMPT'} = 2;
  308.     $opt{'ITEM','ALIGN'} = 2; $opt{'ITEM','COLSPAN'} = 2;
  309.     $opt{'ITEM','ROWSPAN'} = 2; $opt{'LI','BASE'} = 2;
  310.     $opt{'LI','DINGBAT'} = 2; $opt{'LI','MD'} = 2; $opt{'LI','SKIP'} = 2;
  311.     $opt{'LI','SRC'} = 2; $opt{'LI','URN'} = 2; $opt{'MATH','ID'} = 2;
  312.     $opt{'MATH','MODEL'} = 2; $opt{'NOTE','BASE'} = 2; $opt{'NOTE','MD'} = 2;
  313.     $opt{'NOTE','ROLE'} = 2; $opt{'NOTE','SRC'} = 2; $opt{'NOTE','URN'} = 2;
  314.     $opt{'OL','CONTINUE'} = 1; $opt{'OL','INHERIT'} = 1;
  315.     $opt{'OL','START'} = 2; $opt{'OL','TYPE'} = 2; $opt{'OPTION','SHAPE'} = 2;
  316.     $opt{'OVER','SYMBOL'} = 2; $opt{'OVERLAY','BASE'} = 2;
  317.     $opt{'OVERLAY','HEIGHT'} = 2; $opt{'OVERLAY','ISMAP'} = 1;
  318.     $opt{'OVERLAY','MD'} = 2; $opt{'OVERLAY','SEQ'} = 2;
  319.     $opt{'OVERLAY','SRC'} = 2; $opt{'OVERLAY','UNITS'} = 2;
  320.     $opt{'OVERLAY','URN'} = 2; $opt{'OVERLAY','WIDTH'} = 2;
  321.     $opt{'OVERLAY','X'} = 2; $opt{'OVERLAY','Y'} = 2; $opt{'P','ALIGN'} = 2;
  322.     $opt{'P','NOFOLD'} = 1; $opt{'P','NOWRAP'} = 1; $opt{'ROOT','ROOT'} = 2;
  323.     $opt{'SELECT','BASE'} = 2; $opt{'SELECT','MD'} = 2;
  324.     $opt{'SELECT','SRC'} = 2; $opt{'SELECT','URN'} = 2;
  325.     $opt{'SUB','ALIGN'} = 2; $opt{'SUP','ALIGN'} = 2; $opt{'TAB','AFTER'} = 2;
  326.     $opt{'TAB','BEFORE'} = 2; $opt{'TAB','CENTER'} = 1; $opt{'TAB','ID'} = 2;
  327.     $opt{'TAB','RIGHT'} = 1; $opt{'TAB','TO'} = 2; $opt{'TABLE','ALIGN'} = 2;
  328.     $opt{'TABLE','BORDER'} = 1; $opt{'TABLE','COLSPEC'} = 2;
  329.     $opt{'TABLE','UNITS'} = 2; $opt{'TD','ALIGN'} = 2; $opt{'TD','AXES'} = 2;
  330.     $opt{'TD','AXIS'} = 2; $opt{'TD','COLSPAN'} = 2; $opt{'TD','NOWRAP'} = 1;
  331.     $opt{'TD','ROWSPAN'} = 2; $opt{'TD','VALIGN'} = 2; $opt{'TH','ALIGN'} = 2;
  332.     $opt{'TH','AXES'} = 2; $opt{'TH','AXIS'} = 2; $opt{'TH','COLSPAN'} = 2;
  333.     $opt{'TH','NOWRAP'} = 1; $opt{'TH','ROWSPAN'} = 2;
  334.     $opt{'TH','VALIGN'} = 2; $opt{'TR','ALIGN'} = 2; $opt{'TR','VALIGN'} = 2;
  335.     $opt{'UL','BASE'} = 2; $opt{'UL','DINGBAT'} = 2; $opt{'UL','MD'} = 2;
  336.     $opt{'UL','PLAIN'} = 1; $opt{'UL','SRC'} = 2; $opt{'UL','URN'} = 2;
  337.     $opt{'UL','WRAP'} = 2; $txtf{'ADDRESS'} = 1; $txtf{'BLOCKQUOTE'} = 1;
  338.     $txtf{'BQ'} = 1; $txtf{'BR'} = 1; $txtf{'DD'} = 1; $txtf{'DL'} = 1;
  339.     $txtf{'DT'} = 1; $txtf{'FIG'} = 1; $txtf{'H1'} = 1; $txtf{'H2'} = 1;
  340.     $txtf{'H3'} = 1; $txtf{'H4'} = 1; $txtf{'H5'} = 1; $txtf{'H6'} = 1;
  341.     $txtf{'HR'} = 1; $txtf{'LI'} = 1; $txtf{'NOTE'} = 1; $txtf{'OL'} = 1;
  342.     $txtf{'P'} = 1; $txtf{'PRE'} = 1; $txtf{'TABLE'} = 1; $txtf{'UL'} = 1;
  343.     $rqopt{'ARRAY','COLDEF'} = 1; $rqopt{'FIG','SRC'} = 1;
  344.     $rqopt{'NOTE','SRC'} = 1; $rqopt{'OVERLAY','SRC'} = 1; $inidlgs{'ID'} = 1;
  345.     $inidlgs{'LANG'} = 1; $intxtf{'CLEAR'} = 1; $intxtf{'NEEDS'} = 1;
  346.     $html{'HTMLPLUS'} = 1;
  347. #latest HTML3 patches
  348.     $inidlgs{'CLASS'} = 1; $headonly{'STYLE'} = 1; $headonly{'STYLES'} = 1;
  349.     $pcdata{'STYLE'} = 1; $pair{'STYLES'} = 1; $canpair{'STYLE'} = 1;
  350.     $opt{'BODY', 'BACKGROUND'} = 2; $opt{'IMG', 'BASELINE'} = 2;
  351.     $opt{'STYLE', 'ID'} = 2; $opt{'STYLES', 'NOTATION'} = 2;
  352.     $opt{'HTML', 'ROLE'} = 2; $opt{'HTML', 'URN'} = 2;
  353.     $reqopt{'STYLE', 'ID'} = 1; $reqopt{'STYLES', 'NOTATION'} = 1;
  354. #
  355.     $deprec{'HTMLPLUS'} = 1;
  356.     $deprec{'DIR'} = 1; $deprec{'MENU'} = 1; $deprec{'NEXTID'} = 1;
  357.     $deprec{'BLOCKQUOTE'} = 1; $lwlvunp{'MATH'} = 1; $lwlvunp{'FN'} = 1;
  358.     $h3 = 1; undef %nonstd;}
  359. #
  360. #Netscape extensions (I go strictly by the documentation,such as there is, so
  361. #no BLINK):
  362. #
  363. if (($netscape) && ($netscape ne 'off')) {
  364.     $pair{'CENTER'} = 1; $pair{'NOBR'} = 1; $pair{'FONT'} = 1;
  365.     $canpair{'BASEFONT'} = 1; $unpair{'WBR'} = 1; $opt{'ISINDEX','PROMPT'} = 1;
  366.     $opt{'HR','SIZE'} = 2; $opt{'HR','WIDTH'} = 2; $opt{'HR','ALIGN'} = 2;
  367.     $opt{'HR','NOSHADE'} = 1; $opt{'UL','TYPE'} = 2; $opt{'OL','TYPE'} = 2;
  368.     $opt{'OL','START'} = 2; $opt{'LI','TYPE'} = 2; $opt{'LI','VALUE'} = 2;
  369.     $opt{'IMG','WIDTH'} = 2; $opt{'IMG','HEIGHT'} = 2;
  370.     $opt{'IMG','BORDER'} = 2; $opt{'IMG','VSPACE'} = 2;
  371.     $opt{'IMG','HSPACE'} = 2; $opt{'BR','CLEAR'} = 2; $opt{'FONT','SIZE'} = 2;
  372.     $opt{'BASEFONT','SIZE'} = 2; $opt{'P','ALIGN'} = 2;
  373.     $opt{'H1', 'ALIGN'} = 2; $opt{'H2', 'ALIGN'} = 2; $opt{'H3', 'ALIGN'} = 2;
  374.     $opt{'H4', 'ALIGN'} = 2; $opt{'H5', 'ALIGN'} = 2; $opt{'H6', 'ALIGN'} = 2;
  375.     $opt{'IMG','LOWSRC'} = 2; $lwlvunp{'WBR'} = 1; $lwlvunp{'CENTER'} = 1;
  376.     $lowlv{'FONT'} = 1; $lowlv{'NOBR'} = 1;}
  377. #
  378. if ($nonrecurpair) {&setoption('nonrecurpair',$nonrecurpair);}
  379. if ($strictpair) {&setoption('strictpair',$strictpair);}
  380. if ($loosepair) {&setoption('loosepair',$loosepair);}
  381. if ($nonpair) {&setoption('nonpair',$nonpair);}
  382. if ($nonblock) {&setoption('nonblock',$nonblock);}
  383. if ($lowlevelpair) {&setoption('lowlevelpair',$lowlevelpair);}
  384. if ($lowlevelnonpair) {&setoption('lowlevelnonpair',$lowlevelnonpair);}
  385. if ($deprecated) {&setoption('deprecated',$deprecated);}
  386. if ($tagopts) {&setoption('tagopts',$tagopts);}
  387. if ($novalopts) {&setoption('novalopts', $novalopts);}
  388. if ($reqopts) {&setoption('reqopts',$reqopts);}
  389. if (!$dlstrict) {$dlstrict = 1;}
  390. else {
  391.     if ($dlstrict !~ /^[123]$/) {
  392.         die 'Config error: dlstrict= must be 1, 2, or 3';}}
  393. if (!$metachar) {$metachar = 2;}
  394. else {
  395.     if ($metachar !~ /^[123]$/) {
  396.         die 'Config error: metachar= must be 1, 2, or 3';}}
  397. #
  398. if ($refsfile) {
  399.     if ($append) {
  400.         $openstr = '>>';}
  401.     else {
  402.         $openstr = '>';}
  403.     if (!(open(SRC,($openstr . $refsfile . '.SRC')) &&
  404.       open(NAM,($openstr . $refsfile . '.NAME')) &&
  405.       open(HRF,($openstr . $refsfile . '.HREF')) &&
  406.       ((!(($xref) && ($map))) || open(MAP,($openstr . $refsfile . '.MAP'))))) {
  407.         die "Error opening output files!";}
  408.     else {
  409.         print SRC ''; print NAM ''; print HRF '';
  410.         $currf[1] = SRC; $currf[2] = NAM; $currf[3] = HRF;
  411.         if (($xref) && ($map)) {print MAP ''; $currf[4] = MAP;}}}
  412. foreach $X (keys %unpair) {
  413.     if (defined $pair{$X}) {
  414.         die "Internal logical inconsistency: $X defined as both pairing and non-pairing tag";}}
  415. #
  416. #
  417. # Main
  418. #
  419. while (<>) {
  420.     if ($_ =~ /$stuperlRS$/o) { # strip record separator, allow for last line to
  421.         chop;}                  # be unterminated.  I love that /$/$/ syntax,
  422.     #@Fld is unneeded           # but perl doesn't.
  423.     if (($.-$FNRbase) == 1) {
  424.         if ($. != 1) {
  425.             &endit();
  426.             print "\n========================================\n";}
  427.         $fn = $ARGV;
  428.         # Next line is Unix-specific
  429.         $fn =~ s/^\.\///;
  430.         if ($subtract) {
  431.             if (index($fn, $subtract) == 1) {
  432.                 $fn = substr($fn, (length($subtract) + 1));}
  433.             else {
  434.                 die "Filename $fn does not have \042$subtract\042 prefix specified in subtract= option\n".
  435.                   'Exiting prematurely...';}}
  436.         $nampref = ($dirprefix . $fn . '#');
  437.         $lochpref = ($dirprefix . $fn);
  438.         if ($fn =~ /.\//) {
  439.             $fromroot = $fn; $fromroot =~ s/\/[^\057]*$/\//;}
  440.         else {
  441.             $fromroot = '';}
  442.         $fromroot=($dirprefix . $fromroot);
  443.         if ($fn ne '-') {
  444.             if ($inline) {printf 'HTMLCHEK:';}
  445.             print ("Diagnostics for file \"" . $fn . "\":");}}
  446.     if ($inline) {
  447.         print $_;
  448.         $S = 'HTMLCHEK:';}
  449.     else {
  450.         if ($sugar) {$S = ($fn . ': ' . ($.-$FNRbase) . ': ');}}
  451.     $lastbeg = 0; $currsrch = 1; $txtbeg = 1;
  452.     while ((((substr($_, $currsrch) =~ /[<>]/) eq 1) &&
  453.       ($RSTART = length($`)+1)) != 0) {
  454.         $currsrch = ($currsrch + $RSTART);
  455.         if (substr($_, ($currsrch - 1), 1) eq '<') {
  456.             if ($state) {
  457.                 &parsetag($currsrch - 1);
  458.                 $lastbeg = ($currsrch - 1);
  459.                 $state = 1; $continuation = 1;
  460.                 if (!$nxrdo) {$Redo = 1;}
  461.                 if (($metachar != 3) || ((!$inquote) && ($lasttag ne '!--'))) {
  462.                     print $S . "Multiple `<' without `>' ERROR!", &crl();}}
  463.             else {
  464.                 if (($currsrch > length($_)) ||
  465.                   (substr($_, $currsrch, 1) =~ /^[ \t]$/)) {
  466.                     print $S .
  467.                       "Whitespace after `<': Incorrect SGML tag syntax ERROR!",
  468.                       &crl() . ',Ignoring';
  469.                     $wastext = 1;}
  470.                 else {
  471.                     if (!$wastext) {
  472.                         if (substr($_, $txtbeg,
  473.                           ($currsrch - ($txtbeg + 1))) !~ /^[ \t]*$/) {
  474.                             $wastext = 1;}}
  475.                     if ($wastext) {
  476.                         $headbody = $hedbodarr{$hedbodvar};
  477.                         if ((!$bodywarn) && (!$headbody) && ((!$nestvar) ||
  478.                           ($nestarr{$nestvar} eq 'HTML'))) {
  479.                             print $S .
  480.                               'Was non-whitespace outside <body>...</body> Warning!',
  481.                               &crl();
  482.                             $bodywarn = 1;}
  483.                         else {
  484.                             if (($headbody eq 'HEAD') &&
  485.                               ($nestarr{$nestvar} eq 'HEAD')) {
  486.                                 print $S .
  487.                                   'Was non-whitespace in <head>...</head> outside any element ERROR!',
  488.                                   &crl();}}}
  489.                     if (($currsrch == 2) ||
  490.                       (substr($_, ($currsrch - 2), 1) =~ /^[ \t]$/)) {
  491.                         $prews = 1;}
  492.                     $lastbeg = $currsrch; $state = 1; $prevtag = $lasttag;
  493.                     $lasttag = ''; $lastopt = '';}}}
  494.         else {
  495.             if (substr($_, ($currsrch - 1), 1) eq '>') {
  496.                 if ($state == 0) {
  497.                     if (!$nogtwarn) {
  498.                          print $S . "`>' without `<' Warning!", &crl();}
  499.                     $wastext = 1;}
  500.                 else {
  501.                     &parsetag($currsrch - 1);
  502.                     if (($metachar == 3) && (($inquote) || (($lasttag eq '!--') &&
  503.                       (!$comterr) && ($lastcomt ne '--')))) {
  504.                         $lastbeg = ($currsrch - 1);
  505.                         $continuation = 1;
  506.                         if (!$nxrdo) {$Redo = 1;}}
  507.                     else {
  508.                          if (($inquote) || ($inequal)) {
  509.                              &malft();}
  510.                          if ($optfree) {
  511.                              &misstest();}
  512.                          if (($lasttag eq '!--') && ($lastcomt ne '--')) {
  513.                              print $S .
  514.                                "!-- comment not terminated by \042--\042 ERROR!",
  515.                                &crl();}
  516.                          if (($lasttag eq 'IMG') && ($alt == 0)) {
  517.                              print $S . 'IMG tag without ALT option Warning!',
  518.                              &crl();
  519.                              ++$wasnoalt;}
  520.                          if (($lasttag eq 'LINK') && ($linkone == 1) &&
  521.                            ($linktwo == 1)) {
  522.                              ++$linkrmhm;}
  523.                          if (($lasttag eq 'A') && (!$wasname) && (!$washref)) {
  524.                              print $S .
  525.                                '<A> tag occurred without reference (NAME,HREF,ID) option ERROR!',
  526.                                &crl();}
  527.                          $head = ('^' . $lasttag . $;);
  528.                          foreach $X (sort(keys %rqopt)) {
  529.                              if ($X =~ $head) {
  530.                                 @optx = split($;, $X, 2);
  531.                                 if (!(defined $curtagopts{$optx[2]})) {
  532.                                     print $S .
  533.                                       "<$lasttag> tag occurred without $optx[2] option ERROR!",
  534.                                       &crl();}}}
  535.                          if (($wasname > 1) || ($washref > 1)) {
  536.                              print $S .
  537.                                'Multiple reference (NAME,ID;HREF,SRC,BULLET) options ERROR!',
  538.                                &crl(), 'on tag', $lasttag;}
  539.                          if ((!$wastext) && ($lasttag eq ('/' . $prevtag)) &&
  540.                            ($lasttag ne '/TEXTAREA')) {
  541.                              print $S . 'Null <x>...</x> element Warning!',
  542.                                &crl(), "on tag $lasttag";}
  543.                          if (($lasttag =~ /^[AU]$/) &&
  544.                            (($currsrch > length($_)) ||
  545.                            (substr($_, $currsrch, 1) =~ /^[ \t]$/)) &&
  546.                            (!$nowswarn)) {
  547.                              print $S .
  548.                                "Whitespace after `>' of underline markup opening tag Warning!",
  549.                                &crl(), 'on tag', $lasttag;
  550.                              ++$wswarn;}
  551.                          $wastext = 0 ; $txtbeg = $currsrch; $prews = 0;
  552.                          $state = 0; $continuation = 0;}}}
  553.             else {
  554.                 print $S . 'Internal error', &crl(), 'ignore';}}}
  555.     if (($state == 1) || (($lastbeg == 0) &&
  556.       ($continuation == 1))) {
  557.         &parsetag(length($_) + 1);
  558.         $continuation = 1;}
  559.     else {
  560.         if ((!$state) && ($_ !~ /^[ \t]*$/) && ($_ !~ />[ \t]*$/)) {
  561.           $wastext = 1;}}
  562.     if ($_ =~ /&/) {
  563.         s/&[A-Za-z][-A-Za-z0-9.]*;//g;
  564.         s/&[\043][0-9][0-9]*;//g;
  565.         $X = 0;
  566.         $X = s/&+[^a-zA-Z&]//g;
  567.         $X = ($X + s/&+$//g);
  568.         if ($X) {print 'Loose ampersand (may be OK) Warning!', &crl();}
  569.         if ($_ =~ /&/) {
  570.             print $S . 'Apparent non-complying ampersand code ERROR!', &crl();}}}
  571. continue {
  572.     $FNRbase = $. if eof;}
  573. #
  574. # End-of-file routine.
  575. #
  576. if ($. > 0) {
  577.     &endit();
  578.     if ($xref) {
  579.         foreach $X (keys %xhrefarr) {
  580.             if (defined $xnamearr{$X}) {
  581.                 delete $xhrefarr{$X}; delete $xnamearr{$X};}}
  582.         if ($map) {
  583.             foreach $X (sort(keys %xmaparr)) {
  584.                 @mapx = split($;, $X, 2);
  585.                 $xdeparr{$mapx[1]} = ($xdeparr{$mapx[1]} . "\n\t" . $mapx[2]);}}
  586.         if ($refsfile) {
  587.             foreach $X (sort(keys %xnamearr)) {print NAM $X;}
  588.             foreach $X (sort(keys %xhrefarr)) {print HRF $X;}
  589.             foreach $X (sort(keys %xsrcarr))  {print SRC $X;}
  590.             if ($map) {
  591.                 foreach $X (sort(keys %xdeparr)) {
  592.                     print MAP 'File', $X, 'references:' . $xdeparr{$X};}}}
  593.         else {
  594.             print "\n========================================\n";
  595.             print "<A NAME=\042...\042> and ID=\042...\042 locations not " .
  596.               "referenced from within the files checked:\n";
  597.             foreach $X (sort(keys %xnamearr)) {
  598.                 print $X;}
  599.             print "\n----------------------------------------\n";
  600.             print "HREF=\042...\042 references not found in the files checked:\n";
  601.             foreach $X (sort(keys %xhrefarr)) {
  602.                 print $X;}
  603.             print "\n----------------------------------------\n";
  604.             print "SRC=\042...\042 (and BULLET=\042...\042) references:\n";
  605.             foreach $X (sort(keys %xsrcarr)) {
  606.                 print $X;}
  607.             if ($map) {
  608.                 print "\n----------------------------------------\n";
  609.                 print "Reference dependencies:\n";
  610.                 foreach $X (sort(keys %xdeparr)) {
  611.                     print 'File', $X, 'references:' . $xdeparr{$X};}}}}}
  612. #
  613. #
  614. # parsetag() communicates with main() through these global variables:
  615. # - $lastbeg (zero if no `<' ocurred on line, otherwise points to character
  616. #   immediately after the last `<' encountered).
  617. # - $state (one if unresolved `<', zero otherwise).
  618. # - $continuation (one if unresolved `<' from previous line, zero otherwise),
  619. # - $inquote (one if inside option quotes <tag opt="....">).
  620. #
  621. sub parsetag {
  622.     local($inp) = @_;
  623.     if (!$lastbeg) {
  624.         $lastbeg = 1;}
  625.     $numf = (@arr = split(' ', substr($_, $lastbeg, ($inp - $lastbeg))));
  626.     if (substr($_, $lastbeg, ($inp - $lastbeg)) =~ /[ \t]$/) {
  627.         $nxrdo = 1;}
  628.     else {
  629.         $nxrdo = 0;}
  630.     if ($numf == 0) {
  631.         if (!$continuation) {
  632.             print $S . 'Null tagname ERROR!', &crl();
  633.             $state = 0;
  634.             $inquote = 0; $inequal = 0; $optfree = 0; $wasopt = 0; $linkone = 0;
  635.             $linktwo = 0; $wasname = 0; $washref = 0; undef %curtagopts;}
  636.         return;}
  637.     else {
  638.         if (!$continuation) {
  639.             $arr[1] =~ tr/a-z/A-Z/;
  640.             if ($arr[1] =~ /^!--/) {
  641.                 $raw = $arr[1]; $arr[1] = '!--';}
  642.             else {
  643.                 $raw = '';}
  644.             if ($arr[1] =~ /[=\042]/) {
  645.                 print $S . 'Bad tagname ERROR!', &crl(), "on tag $arr[1]";}
  646.             $lasttag = $arr[1]; $alt = 0;
  647.             if ($arr[1] =~ /^\//) {
  648.                 # </TAG> found
  649.                 $arr[1] =~ s/^\///;
  650.                 if (($prews) && ($arr[1] =~ /^[AU]$/) && (!$nowswarn)) {
  651.                     print $S .
  652.                       "Whitespace before `<' of underline closing tag Warning!",
  653.                       &crl(), 'on tag', $lasttag;
  654.                     ++$wswarn;}
  655.                 if (defined $unpair{$arr[1]}) {
  656.                     print $S .
  657.                       'Closing tag on empty element (non-pairing tag) ERROR!',
  658.                       &crl(), 'on tag /' . $arr[1];}
  659.                 else {
  660.                     $poppdstak = 0;
  661.                     if ((defined $pair{$arr[1]}) || (defined $canpair{$arr[1]})) {
  662.                         if (($nestvar <= 0) || ($lev{$arr[1]} <= 0)) {
  663.                             print $S . 'Extraneous /' . $arr[1],
  664.                               'tag without preceding', $arr[1], 'tag ERROR!',
  665.                               &crl() . ', Ignoring';}
  666.                         else {
  667.                             if ($nestarr{$nestvar} ne $arr[1]) {
  668.                                 if (($nestvar > 2) &&
  669.                                   ($nestarr{($nestvar - 2)} eq $arr[1])) {
  670.                                     if ((defined $canpair{$nestarr{$nestvar}}) &&
  671.                                       (($nestarr{($nestvar - 1)} =~ /^L[HI]$/) ||
  672.                                       ($nestarr{($nestvar - 1)} =~ /^D[TD]$/))) {
  673.                                         --$lev{$nestarr{$nestvar}};
  674.                                         --$nestvar; $poppdstak = 1;}}
  675.                                 if (($nestvar > 1) &&
  676.                                   ($nestarr{($nestvar - 1)} eq $arr[1])) {
  677.                                     if (!(defined $canpair{$nestarr{$nestvar}})) {
  678.                                     # Implicit end of optionally-pairing element
  679.                                         print $S . 'Missing /' .
  680.                                           $nestarr{$nestvar},
  681.                                           'tag (should be located before /' .
  682.                                           $arr[1], 'tag) ERROR!', &crl();}
  683.                                     --$lev{$nestarr{$nestvar}}; --$nestvar;
  684.                                     $poppdstak = 1; --$lev{$arr[1]};}
  685.                                 else {
  686.                                     print $S . 'Improper nesting ERROR!',
  687.                                       &crl() . ': /' . $nestarr{$nestvar},
  688.                                       'expected, /' . $arr[1], 'found';
  689.                                     --$lev{$arr[1]};}}
  690.                             else {
  691.                                 --$lev{$arr[1]};}
  692.                             if (defined $list{$nestarr{$nestvar}}) {
  693.                                 if (!$isli{$nestvar}) {
  694.                                     print $S . 'Empty list (without <LI>) ERROR!',
  695.                                       &crl(), 'on tag /' . $arr[1];}
  696.                                 if (($wastext) && (!$poppdstak)) {
  697.                                     print $S . 'Non-whitespace outside <LI> in list ERROR!',
  698.                                       &crl(), 'on tag', $arr[1];}}
  699.                             if ($nestarr{$nestvar} eq 'DL') {
  700.                                 if (!$isdtdd{$nestvar}) {
  701.                                     print $S . 'Empty DL list (without <dt>/<dd>) ERROR!',
  702.                                       &crl();}
  703.                                 if (($wastext) && (!$poppdstak)) {
  704.                                     print $S .
  705.                                       'Non-whitespace outside <dt>/<dd> in <dl> list ERROR!',
  706.                                       &crl(), 'on tag', $arr[1];}}
  707.                             --$nestvar;}}
  708.                     else {
  709.                         $revusarr{$arr[1]} = 1;
  710.                         if ((!$lev{$arr[1]}) || ($lev{$arr[1]} <= 0)) {
  711.                             print $S . 'Extraneous closing tag </x> ERROR!',
  712.                               &crl(), 'on unknown tag /' . $arr[1];}
  713.                         else {
  714.                             --$lev{$arr[1]};}}}
  715.                 if ($arr[1] eq 'HEAD') {
  716.                     if ($title == 0) {
  717.                         print $S . 'No <TITLE> in <head>...</head> ERROR!',
  718.                         &crl();}
  719.                     $base = 0; $title = 0; --$hedbodvar;}
  720.                 if ($arr[1] eq 'BODY') {
  721.                     if ($headone == 0) {
  722.                         print $S .
  723.                           'No <H1> in <body>...</body> Warning!', &crl();}
  724.                     $headone = 0; $bodywarn = 0; --$hedbodvar;}
  725.                 if ((defined $list{$arr[1]}) || (defined $nonlilist{$arr[1]})) {
  726.                     --$listdep;}}
  727.             else {
  728.                 # <TAG> found
  729.                 if ((defined $pcdata{$nestarr{$nestvar}}) &&
  730.                   ($arr[1] ne $nestarr{$nestvar})) {
  731.                     print $S . 'Tag inside', $nestarr{$nestvar},
  732.                       'element ERROR!', &crl(), 'on tag', $lasttag;}
  733.                 if ((defined $pair{$arr[1]}) || (defined $canpair{$arr[1]}) ||
  734.                   (defined $unpair{$arr[1]})) {
  735.                     $known = 1;}
  736.                 else {
  737.                     $known = 0;}
  738.                 if (!((defined $lowlv{$arr[1]}) || (defined $lwlvunp{$arr[1]}))) {
  739.                     $curnest = '';
  740.                     if (($nestvar > 1) && ($arr[1] ne 'LI') &&
  741.                       ($nestarr{$nestvar} eq 'LI') &&
  742.                       (defined $lowlvlist{$nestarr{($nestvar - 1)}})) {
  743.                         $curnest = ('LI in ' . $nestarr{($nestvar - 1)});}
  744.                     else {
  745.                         if ((defined $text{$nestarr{$nestvar}}) ||
  746.                           (defined $lowlv{$nestarr{$nestvar}})) {
  747.                             if (($arr[1] =~ /^H[1-6]$/) &&
  748.                               ($nestarr{$nestvar} eq 'A')) {
  749.                                 print $S . $arr[1],
  750.                                   'heading in <A>...</A> element Warning!',
  751.                                   &crl();}
  752.                             else {
  753.                                 if (($arr[1] ne $nestarr{$nestvar}) &&
  754.                                   (!(($arr[1] eq 'HR') &&
  755.                                   ($nestarr{$nestvar} eq 'PRE')))) {
  756.                                     # inclusion exceptions
  757.                                     if (!((defined $formonly{$arr[1]}) &&
  758.                                       ($lev{'FORM'} > 0))) {
  759.                                          $curnest = $nestarr{$nestvar};}}}}
  760.                         else {
  761.                             if (($arr[1] ne 'P') && ($lev{'ADDRESS'} > 0)) {
  762.                                 $curnest = 'ADDRESS';}}}
  763.                     if ($curnest) {
  764.                         if ($known) {
  765.                             if (!((($arr[1] eq 'LI') ||
  766.                               ($arr[1] =~ /^D[DT]$/)) &&
  767.                               (($nestarr{$nestvar} eq 'DT') ||
  768.                               ($nestarr{$nestvar} eq 'LH')))) {
  769.                                 print $S . $arr[1],
  770.                                   'tag, which is not low-level markup, nested in',
  771.                                   $curnest, 'element ERROR!', &crl();}}
  772.                         else {
  773.                             print $S . 'Unknown tag', $arr[1], 'nested in',
  774.                               $curnest, 'element', $xxllm, 'Warning!', &crl();}}}
  775.                 if (defined $html{$arr[1]}) {
  776.                     ++$lev{'HTML'};}
  777.                 else {
  778.                     ++$lev{$arr[1]};}
  779.                 # Not necessarily immediately contained in FORM
  780.                 if ((defined $formonly{$arr[1]}) &&
  781.                   ($lev{'FORM'} <= 0)) {
  782.                     print $S . '<' . $arr[1] . '> outside of <form>...</form> ERROR!',
  783.                       &crl();}
  784.                 if (($arr[1] eq 'OPTION') && ($nestarr{$nestvar} ne 'SELECT') &&
  785.                   ($nestarr{$nestvar} ne 'OPTION')) {
  786.                     print $S . '<' . $arr[1] .
  787.                       '> outside of <select>...</select> ERROR!', &crl();}
  788.                 if (($arr[1] eq 'STYLE') && ($nestarr{$nestvar} !~ /^STYLES?$/)) {
  789.                     print $S . '<' . $arr[1] .
  790.                       '> outside of <styles>...</styles> ERROR!', &crl();}
  791.                 if (defined $list{$nestarr{$nestvar}}) {
  792.                     if ($wastext) {
  793.                         print $S . 'Non-whitespace outside <LI> in list ERROR!',
  794.                           &crl(), "on tag $arr[1]";}
  795.                     if (($arr[1] ne 'LI') && (!(($arr[1] eq 'LH') && ($h3))) &&
  796.                       ($arr[1] ne '!--')) {
  797.                         print $S . 'Tag in list occurred outside <LI> ERROR!',
  798.                           &crl(), 'on tag', $arr[1];}}
  799.                 if ($nestarr{$nestvar} eq 'DL') {
  800.                     if ($wastext) {
  801.                         print $S .
  802.                           'Non-whitespace outside <dt>/<dd> in <dl> list ERROR!',
  803.                           &crl(), "on tag $arr[1]";}
  804.                     if (($arr[1] !~ /^D[DT]$/) && (!(($arr[1] eq 'LH') &&
  805.                       ($h3))) && ($arr[1] ne '!--')) {
  806.                         print $S .
  807.                           'Tag in <dl> list occurred outside <dt>/<dd> ERROR!',
  808.                           &crl(), 'on tag', $arr[1];}}
  809.                 $headbody = ''; $implicit = 0;
  810.                 if ((defined $pair{$arr[1]}) || (defined $canpair{$arr[1]})) {
  811.                     if (($arr[1] eq 'HEAD') || ($arr[1] eq 'BODY')) {
  812.                         if ((!(defined $lev{'HTML'})) || ($lev{'HTML'} == 0)) {
  813.                             print $S .
  814.                               'HEAD or BODY outside of <HTML>...</HTML> Warning!',
  815.                               &crl();}
  816.                         if ($hedbodvar > 0) {
  817.                             if (($hedbodarr{$hedbodvar} eq 'HEAD') &&
  818.                               ($arr[1] eq 'BODY')) {
  819.                                 $hedbodarr{$hedbodvar} = $arr[1];
  820.                                 --$lev{'HEAD'};
  821.                                 print $S .
  822.                                   "Assumed an implicit `</HEAD>' before <BODY> Warning!",
  823.                                   &crl();
  824.                                 if (($nestarr{$nestvar} ne 'HEAD') &&
  825.                                   (defined $pair{$nestarr{$nestvar}})) {
  826.                                     print $S .
  827.                                       'Improper nesting on implicit </HEAD> ERROR!',
  828.                                       &crl() . ", tag /$nestarr{$nestvar} expected";}
  829.                                 $nestarr{$nestvar} = $arr[1]; $implicit = 1;
  830.                                 if ($title == 0) {
  831.                                     print $S .
  832.                                       'No <TITLE> in <head>...</head> ERROR!',
  833.                                       &crl();}}
  834.                             else {
  835.                                 print $S .
  836.                                   'HEAD or BODY nested inside HEAD or BODY element ERROR!',
  837.                                   &crl();}}
  838.                         else {
  839.                             if (($arr[1] eq 'BODY') && (!(defined $usarr{'HEAD'}))) {
  840.                                 print '<body> without preceding <head>...</head> Warning!',
  841.                                   &crl();}
  842.                             if (($nestvar > 0) && ($nestarr{$nestvar} ne 'HTML')) {
  843.                                 print $S .
  844.                                   'HEAD or BODY contained inside non-HTML element ERROR!',
  845.                                   &crl();}}
  846.                         $hbwarn = 0; $base = 0; $title = 0; $headone = 0;
  847.                         $loosbtag = 0;
  848.                         if ($arr[1] eq 'HEAD') {++$numheads;}
  849.                         if (!$implicit) {
  850.                             ++$hedbodvar;
  851.                             $hedbodarr{$hedbodvar} = $arr[1];}}
  852.                     if (!$implicit) {
  853.                         if ((!(defined $canpair{$nestarr{$nestvar}})) ||
  854.                           (!(defined $canpair{$arr[1]}))) {
  855.                             ++$nestvar;}
  856.                         else {
  857.                             if ((($nestarr{$nestvar} eq 'LH') &&
  858.                               ($arr[1] ne 'LI') && ($arr[1] !~ /^D[TD]$/)) ||
  859.                               (($nestarr{$nestvar} eq 'LI') &&
  860.                               ($arr[1] ne 'LI')) ||
  861.                               (($nestarr{$nestvar} =~ /^D[TD]$/) &&
  862.                               ($arr[1] !~ /^D[TD]$/))) {
  863.                                 ++$nestvar;}
  864.                             else {
  865.                                 if (($nestvar > 2) &&
  866.                                   (($nestarr{($nestvar - 1)} =~ /^L[HI]$/) ||
  867.                                   ($nestarr{($nestvar - 1)} =~ /^D[TD]$/))) {
  868.                                     if ((($nestarr{$nestvar} ne 'LI') &&
  869.                                       ($arr[1] eq 'LI')) ||
  870.                                       (($nestarr{$nestvar} !~ /^D[TD]$/) &&
  871.                                       ($arr[1] =~ /^D[TD]$/))) {
  872.                                         --$nestvar;}}}}
  873.                         if (defined $html{$arr[1]}) {
  874.                             $nestarr{$nestvar} = 'HTML';}
  875.                         else {
  876.                             $nestarr{$nestvar} = $arr[1];}}
  877.                     $isli{$nestvar} = 0; $isdtdd{$nestvar} = 0;
  878.                     $isdt{$nestvar} = 0;}
  879.                 if ($hedbodvar) {
  880.                     $headbody = $hedbodarr{$hedbodvar};}
  881.                 if ((defined $list{$arr[1]}) || (defined $nonlilist{$arr[1]})) {
  882.                     ++$listdep;
  883.                     if ($listdep > $maxlist) {
  884.                         $maxlist = $listdep;}}
  885.                 if ($arr[1] eq 'LI') {
  886.                     $isli{($nestvar - 1)} = 1;
  887.                     if (($nestvar < 2) ||
  888.                       (!(defined $list{$nestarr{($nestvar - 1)}}))) {
  889.                         print $S . '<LI> outside of list ERROR!', &crl();}}
  890.                 if ($arr[1] =~ /^D[DT]$/) {
  891.                     $isdtdd{($nestvar - 1)} = 1;
  892.                     if (($nestvar < 2) || ($nestarr{($nestvar - 1)} ne 'DL')) {
  893.                         print $S . '<dt>/<dd> outside of <dl> list ERROR!',
  894.                           &crl(), 'on tag', $arr[1];}
  895.                     else {
  896.                         if ($arr[1] eq 'DT') {
  897.                             $isdt{($nestvar - 1)} = 1;}
  898.                         else {
  899.                             if ($dlstrict > 1) {
  900.                                 if (!$isdt{($nestvar - 1)}) {
  901.                                 print $S . '<DD> without preceding <DT> in <DL> list Warning!',
  902.                                   &crl();}
  903.                                 if ($dlstrict > 2) {
  904.                                     $isdt{$nestvar - 1} = 0;}
  905.                                 else {
  906.                                     $isdt{$nestvar - 1} = 1;}}}}}
  907.                 if (!$headbody) {
  908.                     if (($lasttag ne '!--') && ($lasttag ne '!DOCTYPE') &&
  909.                       (!(defined $html{$lasttag})) && (!$hbwarn)) {
  910.                         print $S . 'Tag outside of HEAD or BODY element Warning!',
  911.                           &crl(), 'on tag', $arr[1];
  912.                         $hbwarn = 1;}}
  913.                 else {
  914.                     if ($arr[1] eq 'PLAINTEXT') {
  915.                         print $S .
  916.                           '<PLAINTEXT> in <head>...</head> or <body>...</body> ERROR!',
  917.                           &crl();}}
  918.                 if ($headbody eq 'HEAD') {
  919.                     if (!((defined $inhead{$arr[1]}) ||
  920.                       (defined $headonly{$arr[1]}))) {
  921.                         print $S . 'Disallowed tag in <head>...</head> ERROR!',
  922.                           &crl(), 'on tag', $arr[1];}
  923.                     if ($arr[1] eq 'TITLE') {
  924.                         ++$title;
  925.                         if ($title > 1) {
  926.                             print $S . 'Multiple <TITLE> tags in <head> ERROR!',
  927.                               &crl();}}
  928.                     if ($arr[1] eq 'BASE') {
  929.                         ++$base;
  930.                         if ($base > 1) {
  931.                             print $S . 'Multiple <BASE> tags in <head> Warning!',
  932.                               &crl();}}}
  933.                 if (defined $headonly{$arr[1]}) {
  934.                     if ($headbody eq 'BODY') {
  935.                         print $S .
  936.                           'Disallowed tag in <body>...</body> ERROR!', &crl(),
  937.                           'on tag', $arr[1];}
  938.                     else {
  939.                         if (($headbody ne 'HEAD') && ($loosbtag)) {
  940.                             print $S . 'Tag', $arr[1],
  941.                               'that belongs in HEAD occurred after a tag that belongs in BODY ERROR!',
  942.                               &crl();}}}
  943.                 else {
  944.                     if ((!(defined $inhead{$arr[1]})) && (!$headbody) &&
  945.                       ($known) && ($arr[1] ne '!DOCTYPE')) {
  946.                         $loosbtag = 1;}}
  947.                 if ($arr[1] =~ /^H[1-6]$/) {
  948.                     $newheadlev = substr($arr[1], 2, 1);
  949.                     if ($newheadlev > ($headlevel + 1)) {
  950.                         print $S . 'Warning! Jump from header level H' .
  951.                           $headlevel, 'to level H' . $newheadlev, &crl();}
  952.                     $headlevel = $newheadlev;
  953.                     if ($headlevel == 1) {
  954.                         ++$headone;
  955.                         if ($headone > 1) {
  956.                             print $S . 'Multiple <H1> headings Warning!',
  957.                             &crl();}}}
  958.                 if (($arr[1] eq '!DOCTYPE') && ($nestvar)) {
  959.                     print $S . '<!DOCTYPE...> enclosed within <x>...</x> ERROR!',
  960.                       &crl();}
  961.                 if (defined $html{$arr[1]}) {
  962.                     if ($nestvar > 1) {
  963.                         print $S . '<HTML> enclosed within <x>...</x> ERROR!',
  964.                         &crl();}
  965.                     $bodywarn = 0; $hbwarn = 0; $headone = 0; $loosbtag = 0;}
  966.                 if ((defined $nonnest{$arr[1]}) && ($lev{$arr[1]} > 1)) {
  967.                     print $S . 'Self-nesting of unselfnestable tag ERROR!',
  968.                       &crl() . ", of level $lev{$arr[1]} on tag $arr[1]";}}
  969.             if (defined $html{$arr[1]}) {
  970.                 $usarr{'HTML'} = 1;}
  971.             else {
  972.                 $usarr{$arr[1]} = 1;}
  973.             if ($arr[1] eq '!--') {
  974.                 $startf = 1; $comterr = 0; $cmplxcmt = 0; $lastcomt = '';}
  975.             else {
  976.                 $startf = 2;}
  977.             $inquote = 0; $inequal = 0; $optfree = 0; $wasopt = 0; $linkone = 0;
  978.             $linktwo = 0; $wasname = 0; $washref = 0; undef %curtagopts;}
  979.         else {
  980.             $startf = 1;}
  981.         # Remainder of stuff in <...> after tag word
  982.         if ($lasttag !~ /^!/) {
  983.             for ($i = $startf; $i <= $numf; ++$i) {
  984.                 if ((!$inequal) && (!$inquote)) {
  985.                     if (($arr[$i] =~
  986.                       /^[^=\042]*(=\042[^\042]*\042)?$/) ||
  987.                       ($arr[$i] =~ /^[^=\042]*=(\042)?[^\042]*$/)) {
  988.                         if (($optfree) &&
  989.                           (($arr[$i] =~ /^=[^=\042][^=\042]*$/) ||
  990.                           ($arr[$i] =~ /^=\042[^\042]*\042$/))) {
  991.                             if (!$malftag) {
  992.                                 $arr[$i] =~ s/^\075//;
  993.                                 if ($arr[$i] =~ /\042/) {
  994.                                     &optvalproc($arr[$i],1);}
  995.                                 else {&optvalproc($arr[$i],0);}}
  996.                             $optfree = 0;}
  997.                         else {
  998.                             if (($optfree) && (($arr[$i] =~ /^=\042/) ||
  999.                               ($arr[$i] eq '='))) {
  1000.                                 $inequal = 1;}
  1001.                             @arr2 = split(/=/, $arr[$i], 2);
  1002.                             if ($arr2[1] eq '') {
  1003.                                 if (!$inequal) {
  1004.                                     print $S . 'Null tag option ERROR!',
  1005.                                       &crl(), "on tag $lasttag";
  1006.                                 $malftag = 1;}}
  1007.                             else {
  1008.                                 if ($optfree) {
  1009.                                     &misstest();}
  1010.                                 $arr2[1] =~ tr/a-z/A-Z/;
  1011.                                 $optfree = 1; ++$wasopt;
  1012.                                 $malftag = 0; $optvalstr = ''; $Redo = 0;
  1013.                                 if ($lasttag =~ /^\//) {
  1014.                                     print $S . 'Option on closing tag',
  1015.                                     $lasttag, 'ERROR!', &crl();}
  1016.                                 else {
  1017.                                     $optarr{$lasttag, $arr2[1]} = 1;
  1018.                                     $lastopt = $arr2[1];
  1019.                                     if (($lastopt !~ /^[A-Z][-A-Z0-9.]*$/) &&
  1020.                                       ($lastopt ne '<')) {
  1021.                                         print $S .
  1022.                                           "Option name \042$lastopt\042 is not alphanumeric Warning!",
  1023.                                            &crl(), 'on tag', $lasttag;}
  1024.                                     $curtagopts{$lastopt} = 1;
  1025.                                     if (($known) &&
  1026.                                       (!(defined $opt{$lasttag,$lastopt}))) {
  1027.                                         if (!(((defined $idlgs{$lasttag}) &&
  1028.                                           (defined $inidlgs{$lastopt})) ||
  1029.                                           ((defined $txtf{$lasttag}) &&
  1030.                                           (defined $intxtf{$lastopt})))) {
  1031.                                             print $S . $lastopt,
  1032.                                               'not recognized as an option for',
  1033.                                               $lasttag, 'tag Warning!', &crl();}}
  1034.                                     if (($lasttag eq 'IMG') &&
  1035.                                       ($arr2[1] eq 'ALT')) {
  1036.                                         $alt = 1;}}}
  1037.                             if ($arr[$i] =~ /^[^=\042][^=\042]*=$/) {
  1038.                                 $inequal = 1;}
  1039.                             if ($arr[$i] =~ /[\075]/) {
  1040.                                 $optvalstr = $arr[$i];
  1041.                                 $optvalstr =~ s/^[^=]*=//;}
  1042.                             $stuperltmp = $arr[$i];
  1043.                             $Q = ($stuperltmp =~ s/\042//g);
  1044.                             if ($Q == 1) {
  1045.                                 $inquote = 1;}
  1046.                             if (($optvalstr)&&(!$inequal)&&(!$inquote)) {
  1047.                                 $optfree = 0;
  1048.                                 if (!$malftag) {
  1049.                                     &optvalproc($optvalstr,$Q);}}}}
  1050.                     else {
  1051.                         &malft();}}
  1052.                 else {
  1053.                     if (($inequal) && (!$inquote)) {
  1054.                         if ($arr[$i] =~ /\042/) {
  1055.                             if ($arr[$i] =~ /^\042[^\042]*(\042)?$/) {
  1056.                                 $stuperltmp = $arr[$i];
  1057.                                 if (($stuperltmp =~ s/\042//g) == 2) {
  1058.                                     if (!$malftag) {
  1059.                                         $stuperltmp =~ s/^\075//;
  1060.                                         &optvalproc($stuperltmp,1);}
  1061.                                     $inequal = 0; $optfree = 0;}
  1062.                                 else {
  1063.                                     $optvalstr = $arr[$i];
  1064.                                     $inquote = 1;}}
  1065.                             else {
  1066.                                 &malft();}}
  1067.                         else {
  1068.                             if ($arr[$i] !~ /[\075]/) {
  1069.                                 if (!$malftag) {
  1070.                                     &optvalproc($arr[$i],0);}
  1071.                                 $inequal = 0; $optfree = 0;}
  1072.                             else {
  1073.                                 &malft();}}}
  1074.                     else {
  1075.                         if ($arr[$i] =~ /\042/) {
  1076.                             $inquote = 0; $inequal = 0; $optfree = 0;
  1077.                             if ($arr[$i] !~ /^[^\042]*\042$/) {
  1078.                                 &malft();}
  1079.                             else {
  1080.                                 if ($Redo) {
  1081.                                     $optvalstr = ($optvalstr . $arr[$i]);
  1082.                                     $Redo = 0;}
  1083.                                 else {
  1084.                                     $optvalstr = ($optvalstr . ' ' . $arr[$i]);}
  1085.                                 if (!$malftag) {
  1086.                                   &optvalproc($optvalstr,1);}}}
  1087.                         else {
  1088.                             if ($Redo) {
  1089.                                 $optvalstr = ($optvalstr . $arr[$i]);
  1090.                                 $Redo = 0;}
  1091.                             else {
  1092.                                 $optvalstr = ($optvalstr . ' ' . $arr[$i]);}}}}}}
  1093.         else {
  1094.             if ($lasttag eq '!--') {
  1095.                 if (!$continuation) {
  1096.                     $raw =~ s/^!--//; $arr[1] = $raw;}
  1097.                 else {
  1098.                     if (($metachar == 1) && (!$cmplxcmt)) {
  1099.                         print $S . 'Complex comment Warning!', &crl();
  1100.                         $cmplxcmt = 1;}
  1101.                     if ($lastcomt eq '--') {
  1102.                         print $S . "Apparent \042--\042 embedded in comment Warning!",
  1103.                           &crl();
  1104.                         $comterr = 1;}}
  1105.                 for ($i = $startf; $i <= $numf; ++$i) {
  1106.                     if ((($arr[$i] =~ /--/) && ($i < $numf)) ||
  1107.                       (($arr[$i] =~ /--./) && ($i == $numf))) {
  1108.                         print $S . "Apparent \042--\042 embedded in comment Warning!",
  1109.                           &crl();
  1110.                         $comterr = 1;}}
  1111.                 if ($arr[$numf] =~ /--$/) {
  1112.                     $lastcomt = '--';}
  1113.                 else {
  1114.                     $lastcomt = '';}}}
  1115.         return;}}
  1116. #
  1117. #
  1118. # Return as much location information as possible in diagnostics:
  1119. #
  1120. # Current location:
  1121. sub crl {
  1122.     if (($fn)&&($fn ne '-')) {
  1123.         return ('at line ' . ($.-$FNRbase) . " of file \042" . $fn . "\042");}
  1124.     else {
  1125.         return ('at line ' . $.);}}
  1126. #
  1127. # End of file location:
  1128. sub ndl {
  1129.     if (($fn)&&($fn ne '-')) {
  1130.         return ("at END of file \042" . $fn . "\042");}
  1131.     else {
  1132.         return 'at END';}}
  1133. #
  1134. # Error message returned from numerous places in the program...
  1135. #
  1136. sub malft {
  1137.     print $S . 'Malformed tag option ERROR!', &crl(), 'on tag', $lasttag;
  1138.     $malftag = 1;}
  1139. #
  1140. #
  1141. #Check for non-kosher null options:
  1142. #
  1143. sub misstest {
  1144.     if ((($lasttag eq 'A') && ($lastopt eq 'NAME')) || ($lastopt eq 'HREF') ||
  1145.       ($lastopt eq 'ID')) {
  1146.         print $S . 'Missing reference option value ERROR!', &crl(),
  1147.           "on tag $lasttag, option $lastopt";}
  1148.     else {
  1149.         if (($opt{$lasttag, $lastopt} == 2) ||
  1150.           ((defined $idlgs{$lasttag}) && (defined $inidlgs{$lastopt})) ||
  1151.           ((defined $txtf{$lasttag}) && (defined $intxtf{$lastopt}))) {
  1152.             print $S . 'Missing option value ERROR!', &crl(),
  1153.               "on tag $lasttag, option $lastopt";}}}
  1154. #
  1155. #
  1156. #Set property arrays from command line variable or configuration file.
  1157. #
  1158. sub setoption {
  1159.     local($inname, $invalu)  = @_;
  1160.     # allow command line options to override config file
  1161.     if ($inname eq 'htmlplus') {
  1162.         if ($htmlplus) {return;}
  1163.         else {$htmlplus = $invalu; return;}}
  1164.     if ($inname eq 'html3') {
  1165.         if ($html3) {return;}
  1166.         else {$html3 = $invalu; return;}}
  1167.     if ($inname eq 'arena') {
  1168.         if ($arena) {return;}
  1169.         else {$arena = $invalu; return;}}
  1170.     if ($inname eq 'netscape') {
  1171.         if ($netscape) {return;}
  1172.         else {$netscape = $invalu; return;}}
  1173.     if ($inname eq 'dlstrict') {
  1174.         if ($dlstrict) {return;}
  1175.         else {$dlstrict = $invalu; return;}}
  1176.     if ($inname eq 'metachar') {
  1177.         if ($metachar) {return;}
  1178.         else {$metachar = $invalu; return;}}
  1179.     if ($inname eq 'nogtwarn') {
  1180.         $nogtwarn = $invalu; return;}
  1181.     if ($inname eq 'nowswarn') {
  1182.         $nowswarn = $invalu; return;}
  1183.     if ($invalu =~ /\075/) {
  1184.         print STDERR
  1185.           "Invalid syntax on $inname\= configuration option, ignoring";}
  1186.     else {
  1187.         if (($inname eq 'novalopts') || ($inname eq 'tagopts') ||
  1188.           ($inname eq 'reqopts')) {
  1189.             $numf = (@invarr = split(/:/, $invalu));
  1190.             for ($i = 1; $i <= $numf; ++$i) {
  1191.                 $numf2 = (@invarr2 = split(/,/, $invarr[$i], 3));
  1192.                 if ($numf2 != 2) {
  1193.                     print STDERR
  1194.                       "Invalid syntax on $inname\= configuration option, ignoring";}
  1195.                 else {
  1196.                     $invarr2[1] =~ tr/a-z/A-Z/;
  1197.                     $invarr2[2] =~ tr/a-z/A-Z/;
  1198.                     if ($inname eq 'novalopts') {
  1199.                         $opt{$invarr2[1], $invarr2[2]} = 1;}
  1200.                     else {
  1201.                         if ($inname eq 'reqopts') {
  1202.                             $rqopt{$invarr2[1], $invarr2[2]} = 1;}
  1203.                         $opt{$invarr2[1], $invarr2[2]} = 2;}}}}
  1204.         else {
  1205.             $numf = (@invarr = split(/,/, $invalu));
  1206.             for ($i = 1; $i <= $numf; ++$i) {
  1207.                 $invarr[$i] =~ tr/a-z/A-Z/;
  1208.                 if ($inname eq 'nonrecurpair') {
  1209.                     $pair{$invarr[$i]} = 1;
  1210.                     &strictclean($invarr[$i]);
  1211.                     $nonnest{$invarr[$i]} = 1;}
  1212.                 elsif ($inname eq 'strictpair') {
  1213.                     $pair{$invarr[$i]} = 1;
  1214.                     &strictclean($invarr[$i]);
  1215.                     delete $nonnest{$invarr[$i]};}
  1216.                 elsif ($inname eq 'loosepair') {
  1217.                     if (¬redef($invarr[$i])) {
  1218.                         $canpair{$invarr[$i]} = 1;
  1219.                         delete $unpair{$invarr[$i]};
  1220.                         &nonstrictclean($invarr[$i]);}}
  1221.                 elsif ($inname eq 'nonpair') {
  1222.                     if (¬redef($invarr[$i])) {
  1223.                         $unpair{$invarr[$i]} = 1;
  1224.                         delete $canpair{$invarr[$i]};
  1225.                         &nonstrictclean($invarr[$i]);}}
  1226.                 elsif ($inname eq 'nonblock') {
  1227.                     $text{$invarr[$i]} = 1;
  1228.                     delete $unpair{$invarr[$i]};}
  1229.                 elsif ($inname eq 'lowlevelpair') {
  1230.                     $lowlv{$invarr[$i]} = 1;
  1231.                     &strictclean($invarr[$i]);}
  1232.                 elsif ($inname eq 'lowlevelnonpair') {
  1233.                     if (¬redef($invarr[$i])) {
  1234.                         $text{$invarr[$i]} = 1;
  1235.                         &nonstrictclean($invarr[$i]);}}
  1236.                 elsif ($inname eq 'deprecated') {
  1237.                     $deprec{$invarr[$i]} = 1;}
  1238.                 else {print STDERR 'Unrecognized configuration option', $inname;
  1239.                     return;}}}}}
  1240. #
  1241. sub strictclean {
  1242.     local($param) = @_;
  1243.     delete $nonstd{$param};
  1244.     delete $unpair{$param};
  1245.     delete $canpair{$param};
  1246.     delete $lwlvunp{$param};}
  1247. #
  1248. sub nonstrictclean {
  1249.     local($param) = @_;
  1250.     delete $nonstd{$param};
  1251.     delete $pair{$param};
  1252.     delete $nonnest{$param};
  1253.     delete $lowlv{$param};}
  1254. #
  1255. #Stuff which has special hard-wired processing; don't allow user to redefine
  1256. #
  1257. sub notredef {
  1258.     local($param) = @_;
  1259.     if ((defined $list{$param}) || (defined $nonlilist{$param}) ||
  1260.       (defined $html{$param}) || ($param eq 'HEAD') || ($param eq 'BODY')) {
  1261.         return 0;}
  1262.     else {
  1263. return 1;}}
  1264. #
  1265. #
  1266. # This subroutine receives the raw option value string, for every tag option
  1267. # that does have a value.  It does some errorchecking and cleanup, and writes
  1268. # to the .NAME, .HREF, and .SRC files when requested.
  1269. #
  1270. sub optvalproc {
  1271.     local($val, $quoted) = @_;
  1272.     $currfn = 0;
  1273.     if ($quoted) {
  1274.         $val =~ s/\042//g; $val =~ s/^ //; $val =~ s/ $//;}
  1275.     if ($lasttag eq 'LINK') {
  1276.         if (($lastopt eq 'REV')&&($val =~ /^MADE$/i)) {
  1277.             ++$linkone;}
  1278.         if (($lastopt eq 'HREF')&&($val =~ /^mailto:/)) {
  1279.             ++$linktwo;}}
  1280.     if (($usebase) && ($lasttag eq 'BASE') && ($lastopt eq 'HREF')) {
  1281.         if (($quoted) && ($val) && ($val ne '=') && ($val !~ /[^ ] [^ ]/)) {
  1282.             $nampref = ($val . '#'); $lochpref = $val;
  1283.             if ($val =~ /.\//) {
  1284.                 $fromroot = $val;
  1285.                 $fromroot =~ s/\/[^\057]*$/\//;}
  1286.             else {
  1287.                 $fromroot = '';}}
  1288.         else {
  1289.             print $S . "Bad <BASE HREF=\042...\042>", &crl() . ', Ignoring';}}
  1290.     else {
  1291.         if ((($lasttag eq 'A') && ($lastopt eq 'NAME')) || ($lastopt eq 'ID')) {
  1292.             $currfn = 2; ++$wasname;
  1293.             if (($val) && ($val ne '=')) {
  1294.                 if (defined $namearr{('#' . $val)}) {
  1295.                     print $S . "Duplicate location \042#" . $val .
  1296.                       "\042 ERROR!", &crl(), 'on tag', $lasttag, 'option',
  1297.                       $lastopt;}
  1298.                 else {
  1299.                     if ($val =~ /^#/) {
  1300.                         print $S . "Invalid #-initial location \042" .
  1301.                           $val . "\042 ERROR!", &crl(), 'on tag', $lasttag,
  1302.                           'option', $lastopt;}
  1303.                     else {
  1304.                         $namearr{('#' . $val)} = 1;}}}}
  1305.         else {
  1306.             if (($lastopt eq 'SRC') || ($lastopt eq 'BULLET')) {
  1307.                 $currfn = 1; ++$washref;}
  1308.             else {
  1309.                 if ($lastopt eq 'HREF') {
  1310.                     $currfn = 3; ++$washref;
  1311.                     if ($val =~ /^#/) {
  1312.                         $loclhrefarr{$val} = 1;}}}}}
  1313.     if ($currfn) {
  1314.         if ($val =~ /[^-a-zA-Z0-9.]/) {
  1315.             if (!$quoted) {
  1316.                 print $S .
  1317.                   'Unquoted non-alphanumeric reference option value ERROR!',
  1318.                   &crl(), 'on tag', $lasttag . ', option', $lastopt;}
  1319.             else {
  1320.                 if ($currfn == 2) {
  1321.                     print $S .
  1322.                       "Character other than `A-Z', `a-z', `0-9', `-', or `.' in location name Warning!",
  1323.                       &crl(), 'on tag', $lasttag . ', option', $lastopt;}}}
  1324.         else {
  1325.             if (!$quoted) {
  1326.                 print $S . 'Unquoted reference option value Warning!', &crl(),
  1327.                   'on tag', $lasttag . ', option', $lastopt;}}
  1328.         if ($val =~ /[^ ] [^ ]/) {
  1329.             print $S . 'Whitespace in reference option value Warning!',
  1330.               &crl(), "on tag $lasttag, option $lastopt";}
  1331.         else {
  1332.             if ($val eq '') {
  1333.                 print $S . 'Null reference option value ERROR!', &crl(),
  1334.                   "on tag $lasttag, option $lastopt";}
  1335.             else {
  1336.                 # Skip the residue of Malformed Tag Option cases;  OK to do
  1337.                 # this, since "=" is not a valid URL;  However, a minor bug
  1338.                 # is that <A NAME="="> will not be checked, and will not
  1339.                 # result in any errormessage.
  1340.                 if ((($refsfile) || ($xref)) && ($val ne '=')) {
  1341.                     if ($currfn == 2) {
  1342.                         $val = ($nampref . $val);}
  1343.                     else {
  1344.                         if (($currfn == 3) && ($val =~ /^#/)) {
  1345.                             $val = ($lochpref . $val);}
  1346.                         else {
  1347.                             if ($val =~ /^http:[^\057]*$/) {
  1348.                                 $val =~ s/^http://;}
  1349.                             if (($val !~ /^[^\057]*:/) && ($val !~ /^\//)) {
  1350.                                 if ($val =~ /^~/) {
  1351.                                     print $S .
  1352.                                       "Relative URL beginning with '~' Warning!",
  1353.                                       &crl(),"on tag $lasttag option $lastopt";}
  1354.                                 else {
  1355.                                     $val = ($fromroot . $val);}}}}
  1356.                     # This monstrosity supports "../" in URL's:
  1357.                     while ($val =~ /\057[^\057]*[^\057]\057\.\.\057/) {
  1358.                         $val =~ s/\057[^\057]*[^\057]\057\.\.\057/\057/;}
  1359.                     if (($val =~ /[:\057]\.\.\057/) || ($val =~ /^\.\.\057/)) {
  1360.                         print $S . "Unresolved \042../\042 in URL Warning!",
  1361.                           &crl(), "on tag $lasttag option $lastopt";}
  1362.                     if (!$xref) {
  1363.                         $stuperltmp =  $currf[$currfn];
  1364.                         print $stuperltmp $val;}
  1365.                     else {
  1366.                         if ($currfn == 1) {
  1367.                             $xsrcarr{$val} = 1;
  1368.                             if ($map) {
  1369.                                 $xmaparr{$lochpref, $val} = 1;}}
  1370.                         else {
  1371.                             if ($currfn == 2) {
  1372.                                 $xnamearr{$val} = 1;}
  1373.                             else {
  1374.                                 if ($currfn == 3) {
  1375.                                     $xhrefarr{$val} = 1;
  1376.                                     if ($map) {
  1377.                                         if ($val =~ /#[^\057#]*$/) {
  1378.                                             $val =~ s/#[^\057#]*$//;}
  1379.                                         $xmaparr{$lochpref, $val} = 1;}}}}}}}}}
  1380.     else {
  1381.         if ((!$quoted) && ($val ne '=')) {
  1382.             if ($val =~ /[^-a-zA-Z0-9.]/) {
  1383.                 print $S . "Unquoted non-alphanumeric option value \042" .
  1384.                   $val . "\042 Warning!", &crl(), 'on tag option', $lastopt;}
  1385.             else {
  1386.                 if ($val =~ /[^-0-9.]/) {
  1387.                     $val =~ tr/a-z/A-Z/;
  1388.                     $unqopt{($lastopt . '=' . $val)} = 1;}}}}}
  1389. #
  1390. #
  1391. # Start each file with a clean slate.
  1392. #
  1393. sub initscalrs {
  1394.     $state = 0; $continuation = 0; $nestvar = 0; $bodywarn = 0; $maxlist = 0;
  1395.     $listdep = 0; $headone = 0; $headlevel = 0; $br = 0; $wasnoalt = 0;
  1396.     $loosbtag = 0; $wswarn = 0; $hedbodvar = 0; $linkrmhm = 0;
  1397.     $wastext = 0; $prevtag = ''; $hbwarn = 0; $S = ''; $prews = 0;
  1398.     $numheads = 0; $lasttag = '';}
  1399. #
  1400. #
  1401. # File-final global errors and tag diagnostics.
  1402. #  Information is passed here through arrays:
  1403. # - $usarr{$x}:     The tag <x> was used.
  1404. # - $revusarr{$x}:  The reverse tag </x> was used.
  1405. # - $lev{$x}:       Current degree of self-nesting of paired tag <x>...</x>.
  1406. # - $optarr{$x,$y}: The option y was used with tag <x>.
  1407. #and also through the variables $maxlist and $continuation.
  1408. #
  1409. sub endit {
  1410.     if (!$xref) {
  1411.         if ($refsfile) {
  1412.             print NAM $lochpref;}}
  1413.     else {
  1414.         $xnamearr{$lochpref} = 1;}
  1415.     if ($inline) {
  1416.         $S = 'HTMLCHEK:';}
  1417.     else {
  1418.         if ($sugar) {
  1419.             $S = ($fn . ': END: ');}}
  1420.     if ($continuation) {
  1421.         print $S . "Was awaiting a `>' ERROR!", &ndl();}
  1422.     if (($wastext) && (!$bodywarn)) {
  1423.         print $S . 'File-final uncontained non-whitespace Warning!',&ndl();}
  1424.     foreach $X (sort(keys %usarr)) {
  1425.         if ((defined $pair{$X}) && ($lev{$X} > 0)) {
  1426.                 print $S . 'Pending unresolved <x> without </x> ERROR! of level',
  1427.                   $lev{$X}, &ndl(), 'on tag', $X;}}
  1428.     if (!(defined $usarr{'HTML'})) {
  1429.         print $S . '<HTML> not used in document Warning!', &ndl();}
  1430.     if (!(defined $usarr{'HEAD'})) {
  1431.         print $S . '<HEAD> not used in document Warning!', &ndl();}
  1432.     if (!(defined $usarr{'BODY'})) {
  1433.         print $S . '<BODY> not used in document Warning!', &ndl();}
  1434.     if ($linkrmhm == 0) {
  1435.         print $S . "<LINK REV=\"made\" HREF=\"mailto:...\"> not used in document Warning!",
  1436.           &ndl();}
  1437.     if ($numheads > 1) {
  1438.         print $S . '<HEAD> used multiple (' . $numheads . ') times ERROR!',
  1439.           &ndl();}
  1440.     if (!(defined $usarr{'TITLE'})) {
  1441.         print $S . '<TITLE> not used in document ERROR!', &ndl();}
  1442.     if ($wasnoalt) {
  1443.         print $S . '<IMG> tags were found without ALT option', $wasnoalt,
  1444.           'times Warning!', &ndl();
  1445.         print
  1446.           "Advice: Add ALT=\042\042 to purely decorative images, and meaningful text to others.";}
  1447.     if ($wswarn) {
  1448.         print $S . 'Whitespace separated underlining tags from enclosed element',
  1449.           $wswarn, 'times Warning!', &ndl();
  1450.         print
  1451.           "Advice: Change ``<X> text </X>'' syntax to preferred ``<X>text</X>'' syntax.";}
  1452.     foreach $X (sort(keys %loclhrefarr)) {
  1453.         if (!(defined $namearr{$X})) {
  1454.             print $S . "Was a dangling file-local reference \042$X\042 ERROR!",
  1455.               &ndl();}}
  1456.     foreach $X (sort(keys %unqopt)) {
  1457.         if (!$br) {
  1458.             printf "\n";
  1459.             if ($inline) {printf 'HTMLCHEK:';}
  1460.             printf "Unquoted tag option=value pairs:";
  1461.             $br = 1;}
  1462.         printf ' %s', $X;}
  1463.     if ($br) {
  1464.         printf "\n";}
  1465.     foreach $X (sort(keys %usarr)) {
  1466.         $options = ''; $head = ('^' . $X . $;);
  1467.         foreach $Z (sort(keys %optarr)) {
  1468.             if ($Z =~ $head) {
  1469.                 @optx = split($;, $Z, 2);
  1470.                 $options = ($options . ' ' . $optx[2]);}}
  1471.         $unknown = 0;
  1472.         if (!$br) {
  1473.             print '';
  1474.             $br = 1;}
  1475.         if ($inline) {printf 'HTMLCHEK:';}
  1476.         printf '%s %s %s', 'Tag', $X, 'occurred';
  1477.         if ($options) {
  1478.             printf '%s%s', ', with options', $options;}
  1479.         if (!((defined $pair{$X}) || (defined $canpair{$X}) ||
  1480.              (defined $unpair{$X}))) {
  1481.             printf '%s%s', '; Warning! tag is unknown ', &ndl();
  1482.             $unknown = 1;
  1483.             if ($X !~ /^[A-Z!][-A-Z0-9.]*$/) {
  1484.                 printf '%s%s', "; Warning! tag is not alphanumeric ", &ndl();}}
  1485.         if (defined $deprec{$X}) {
  1486.             printf '%s%s', '; Warning! tag is obsolescent and deprecated ', &ndl();}
  1487.         else {
  1488.             if (defined $nonstd{$X}){
  1489.                 printf '%s%s',
  1490.                   "; Warning! tag is not (yet) a part of HTML standard ", &ndl();}}
  1491.         if (($unknown) && (defined $revusarr{$X}) && ($lev{$X} != 0)) {
  1492.             printf '%s%s%s%s%s%s%s%s%s%s%s%s', '; Closing tag </', $X,
  1493.               '> of unknown tag ', $X, ' encountered and balance of <', $X,
  1494.               '> minus </', $X, '> nonzero (', $lev{$X}, ') Warning! ', &ndl();}
  1495.         printf "\n";}
  1496.     if ($maxlist) {
  1497.         if ($inline) {printf 'HTMLCHEK:';}
  1498.         print 'Maximum depth of list embedding was', $maxlist;}
  1499.     #Reinitialize for next file
  1500.     &initscalrs();
  1501.     undef %unqopt; undef %namearr; undef %loclhrefarr;
  1502.     undef %lev; undef %usarr; undef %optarr; undef %revusarr;}
  1503. #-=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-  -=-
  1504. ##EOF
  1505.