home *** CD-ROM | disk | FTP | other *** search
/ El Mac 8 / El Mac 8.iso / Shareware / Utilities / MacWebLint 1.014 / MacWebLint.source < prev    next >
Encoding:
Text File  |  1996-02-25  |  29.2 KB  |  1,072 lines  |  [TEXT/ttxt]
  1. #!/usr/local/bin/perl
  2.  
  3. # JS 2-4-96
  4. # Moved a bunch of the subs to this file so that this file could be opened
  5. # and modified by MacPerl because it was >32k before.
  6. require "MacWebLint-Lib.pl";
  7.  
  8. ## This sets the location of the results file.
  9. $pwd = `pwd`;
  10. chop ($pwd);
  11. $gResults = $pwd . ":" . "MacWebLint Results";
  12.  
  13. # weblint - pick fluff off WWW pages (html).
  14. #
  15. # Copyright (C) 1994, 1995, 1996 Neil Bowers.  All rights reserved.
  16. #
  17. # See README for additional blurb.
  18. # Bugs, comments, suggestions welcome: neilb@khoral.com
  19. #
  20. # Latest version is available as:
  21. #    ftp://ftp.khoral.com/pub/weblint/weblint.tar.gz
  22. #
  23. $VERSION  = '1.014';
  24. ($PROGRAM = $0) =~ s@.*/@@;
  25. $TMPDIR   = $ENV{'TMPDIR'} || '/usr/tmp';
  26. $ToDoURL  = 'ftp://ftp.khoral.com/pub/weblint/todo.txt';
  27.  
  28. #------------------------------------------------------------------------
  29. # $version - the string which is displayed with -v or -version
  30. #------------------------------------------------------------------------
  31. $versionString=<<EofVersion;
  32.     This is weblint, version $VERSION
  33.  
  34.     Copyright 1994,1995,1996 Neil Bowers
  35.  
  36.     Weblint may be used and copied only under the terms of the Artistic
  37.     License, which may be found in the Weblint source kit, or at:
  38.             http://www.khoral.com/staff/neilb/weblint/artistic.html
  39. EofVersion
  40.  
  41. *WARNING = *STDOUT;
  42.  
  43. # obsolete tags
  44. $obsoleteTags = 'PLAINTEXT|XMP|LISTING|COMMENT';
  45.  
  46. $maybePaired  = 'LI|DT|DD|P|ROW|TD|TH|TR';
  47.  
  48. $pairElements = 'A|ABBREV|ABOVE|ACRONYM|ADDRESS|ARRAY|AU|'.
  49.                 'HTML|HEAD|BANNER|BAR|BELOW|BIG|BLOCKQUOTE|BODY|BOX|BQ|BT|'.
  50.                 'CAPTION|CREDIT|DDOT|DEL|DIV|DOT|'.
  51.                 'FIG|FN|H1|H2|H3|H4|H5|H6|HAT|INS|LH|OVERLAY|'.
  52.         'B|I|U|TT|STRONG|EM|CODE|KBD|VAR|DFN|CITE|SAMP|Q|LANG|'.
  53.         'UL|OL|DL|'.
  54.                 'MATH|MENU|DIR|FORM|NOTE|PERSON|ROOT|'.
  55.                 'S|SELECT|SMALL|SQRT|STRIKE|STYLE|'.
  56.                 'SUB|SUP|T|TABLE|TEXT|TEXTAREA|TILDE|TITLE|VEC|CODE|PRE|'.
  57.                 $maybePaired.'|'.
  58.                 $obsoleteTags;
  59.  
  60. # container elements which shouldn't have leading or trailing whitespace
  61. $cuddleContainers = 'A|H1|H2|H3|H4|H5|H6|TITLE';
  62.  
  63. # expect to see these tags only once
  64. %onceOnly = ('HTML', 1, 'HEAD', 1, 'BODY', 1, 'TITLE', 1);
  65.  
  66. %physicalFontElements =
  67. (
  68.  'B',  'STRONG',
  69.  'I',  'EM',
  70.  'TT', 'CODE, SAMP, KBD, or VAR'
  71.  );
  72.  
  73. # expect these tags to have attributes
  74. # these are elements which have no required attributes, but we expect to
  75. # see at least one of the attributes
  76. $expectArgsRE = 'A';
  77.  
  78. # these tags can only appear in the head element
  79. $headTagsRE = 'TITLE|NEXTID|LINK|BASE|META';
  80.  
  81. %requiredContext =
  82. (
  83.  'ABOVE',     'MATH',
  84.  'ARRAY',     'MATH',
  85.  'ATOP',      'BOX',
  86.  'BAR',       'MATH',
  87.  'BELOW',     'MATH',
  88.  'BOX',       'MATH',
  89.  'BT',        'MATH',
  90.  'CAPTION',   'TABLE|FIG',
  91.  'CHOOSE',    'BOX',
  92.  'DD',        'DL',
  93.  'DDOT',      'MATH',
  94.  'DOT',       'MATH',
  95.  'DT',        'DL',
  96.  'HAT',       'MATH',
  97.  'INPUT',     'FORM',
  98.  'ITEM',      'ROW',
  99.  'LEFT',      'BOX',
  100.  'LH',        'DL|OL|UL',
  101.  'LI',        'DIR|MENU|OL|UL',
  102.  'OF',        'ROOT',
  103.  'OPTION',    'SELECT',
  104.  'OVER',      'BOX',
  105.  'OVERLAY',   'FIG',
  106.  'RIGHT',     'BOX',
  107.  'ROOT',      'MATH',
  108.  'ROW',       'ARRAY',
  109.  'SELECT',    'FORM',
  110.  'SQRT',      'MATH',
  111.  'T',         'MATH',
  112.  'TD',        'TR',
  113.  'TEXT',      'MATH',
  114.  'TEXTAREA',  'FORM',
  115.  'TH',        'TR',
  116.  'TILDE',     'MATH',
  117.  'TR',        'TABLE',
  118.  'VEC',       'MATH'
  119.  );
  120.  
  121. # these tags are allowed to appear in the head element
  122. %okInHead = ('ISINDEX', 1, 'TITLE', 1, 'NEXTID', 1, 'LINK', 1,
  123.          'BASE', 1, 'META', 1, 'RANGE', 1, 'STYLE', 1, '!--', 1);
  124.  
  125. # expect to see these at least once.
  126. # html-outer covers the HTML element
  127. @expectedTags = ('HEAD', 'TITLE', 'BODY');
  128.  
  129. # elements which cannot be nested
  130. $nonNest = 'A|FORM';
  131.  
  132. $netscapeElements = 'NOBR|WBR|FONT|FRAME|FRAMESET|NOFRAMES|BASEFONT|BLINK|'.
  133.                     'CENTER|MAP|AREA|SCRIPT';
  134. $javaElements = 'APPLET|PARAM';
  135.  
  136. #
  137. # This is a regular expression for all legal elements
  138. # UPDATE: need to remove duplication in legalElements and pairElements
  139. #
  140. $legalElements =
  141.    'A|ABBREV|ABOVE|ACRONYM|ADDRESS|ARRAY|ATOP|AU|'.
  142.    'B|BANNER|BAR|BASE|BELOW|BIG|BLOCKQUOTE|BODY|BOX|BQ|BR|BT|'.
  143.    'CAPTION|CHOOSE|CITE|CODE|CREDIT|'.
  144.    'DD|DDOT|DFN|DEL|DIR|DIV|DL|DOT|DT|'.
  145.    'EM|FIG|FN|FORM|H1|H2|H3|H4|H5|H6|HAT|HEAD|HR|HTML|'.
  146.    'I|IMG|INPUT|INS|ISINDEX|ITEM|KBD|'.
  147.    'LANG|LEFT|LH|LI|LINK|MATH|MENU|META|NEXTID|NOTE|'.
  148.    'OF|OL|OPTION|OVER|OVERLAY|P|PERSON|PRE|Q|RANGE|RIGHT|ROOT|ROW|'.
  149.    'SAMP|SELECT|S|SMALL|SQRT|STRIKE|STRONG|STYLE|SUB|SUP|'.
  150.    'T|TAB|TABLE|TD|TEXT|TEXTAREA|TH|TILDE|TITLE|TR|TT|U|UL|VAR|VEC|'.
  151.    $obsoleteTags;
  152.  
  153. # This table holds the valid attributes for elements
  154. # Where an element does not have an entry, this implies that the element
  155. # does not take any attributes
  156. %validAttributes =
  157.    (
  158.    'A',          'ID|LANG|CLASS|HREF|MD|NAME|SHAPE|TITLE|REL|REV',
  159.    'ABOVE',      'SYM',
  160.    'ADDRESS',    'ID|LANG|CLASS|CLEAR|NOWRAP',
  161.    'ARRAY',      'ALIGN|COLDEF|LDELIM|RDELIM|LABELS',
  162.    'BANNER',     'ID|LANG|CLASS',
  163.    'BASE',       'HREF',
  164.    'BR',         'ID|LANG|CLASS|CLEAR',
  165.    'BLOCKQUOTE', 'ID|LANG|CLASS|CLEAR|NOWRAP',
  166.    'BODY',       'ID|LANG|CLASS|BACKGROUND',
  167.    'BOX',        'SIZE',
  168.    'BQ',         'ID|LANG|CLASS|CLEAR|NOWRAP',
  169.    'BELOW',      'SYM',
  170.    'CAPTION',    'ID|LANG|CLASS|ALIGN',
  171.    'CREDIT',     'ID|LANG|CLASS',
  172.    'DD',         'ID|LANG|CLASS|CLEAR',
  173.    'DIV',        'ID|LANG|CLASS|ALIGN|NOWRAP|CLEAR',
  174.    'DL',         'ID|LANG|CLASS|CLEAR|COMPACT',
  175.    'DT',         'ID|LANG|CLASS|CLEAR',
  176.    'FIG',        'ID|LANG|CLASS|CLEAR|NOFLOW|SRC|MD|ALIGN|WIDTH|HEIGHT|'.
  177.                  'UNITS|IMAGEMAP',
  178.    'FN',         'ID|LANG|CLASS',
  179.    'FORM',       'ACTION|METHOD|ENCTYPE|SCRIPT',
  180.    'H1',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  181.    'H2',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  182.    'H3',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  183.    'H4',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  184.    'H5',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  185.    'H6',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  186.    'HR',         'ID|CLASS|CLEAR|SRC|MD',
  187.    'HTML',       'VERSION|URN|ROLE',
  188.    'IMG',        'ID|LANG|CLASS|SRC|MD|WIDTH|HEIGHT|UNITS|ALIGN|ALT|ISMAP',
  189.    'INPUT',      'ID|LANG|CLASS|TYPE|NAME|VALUE|DISABLED|ERROR|CHECKED|SIZE|'.
  190.                  'MAXLENGTH|MIN|MAX|ACCEPT|SRC|MD|ALIGN',
  191.    'ITEM',       'ALIGN|COLSPAN|ROWSPAN',
  192.    'LH',         'ID|LANG|CLASS',
  193.    'LI',         'ID|LANG|CLASS|CLEAR|SRC|MD|DINGBAT|SKIP',
  194.    'LINK',       'HREF|REL|REV|URN|TITLE|METHODS',
  195.    'MATH',       'ID|CLASS|BOX',
  196.    'META',       'HTTP-EQUIV|NAME|CONTENT',
  197.    'NEXTID',     'N',
  198.    'NOTE',       'ID|LANG|CLASS|CLEAR|SRC|MD',
  199.    'OL',         'ID|LANG|CLASS|CLEAR|CONTINUE|SEQNUM|COMPACT',
  200.    'OPTION',     'ID|LANG|CLASS|DISABLED|ERROR|VALUE|SELECTED|SHAPE',
  201.    'OVERLAY',    'SRC|MD|UNITS|X|Y|WIDTH|HEIGHT',
  202.    'P',          'ID|LANG|CLASS|ALIGN|CLEAR|NOWRAP',
  203.    'PRE',        'ID|LANG|CLASS|CLEAR|WIDTH',
  204.    'RANGE',      'ID|CLASS|FROM|UNTIL',
  205.    'ROW',        'ALIGN|COLSPAN|ROWSPAN',
  206.    'SELECT',     'ID|LANG|CLASS|NAME|MULTIPLE|DISABLED|ERROR|SRC|MD|WIDTH|'.
  207.                  'HEIGHT|UNITS|ALIGN|SIZE',
  208.    'STYLE',      'NOTATION',
  209.    'TAB',        'ID|INDENT|TO|ALIGN|DP',
  210.    'TABLE',      'ID|LANG|CLASS|CLEAR|NOFLOW|ALIGN|UNITS|COLSPEC|DP|WIDTH|'.
  211.                  'BORDER|NOWRAP',
  212.    'TD',         'ID|LANG|CLASS|COLSPAN|ROWSPAN|ALIGN|DP|VALIGN|NOWRAP|'.
  213.                  'AXIS|AXES',
  214.    'TEXTAREA',   'ID|LANG|CLASS|NAME|ROWS|COLS|DISABLED|ERROR|ALIGN',
  215.    'TH',         'ID|LANG|CLASS|COLSPAN|ROWSPAN|ALIGN|DP|VALIGN|NOWRAP|'.
  216.                  'AXIS|AXES',
  217.    'TR',         'ID|LANG|CLASS|ALIGN|DP|VALIGN|NOWRAP',
  218.    'UL',         'ID|LANG|CLASS|CLEAR|PLAIN|SRC|MD|DINGBAT|WRAP|COMPACT',
  219.    );
  220.  
  221. %requiredAttributes =
  222.    (
  223.    'BASE',     'HREF',
  224.    'FORM',     'ACTION',
  225.    'IMG',      'SRC',
  226.    'LINK',     'HREF',
  227.    'NEXTID',   'N',
  228.    'SELECT',   'NAME',
  229.    'STYLE',    'NOTATION',
  230.    'TEXTAREA', 'NAME|ROWS|COLS'
  231.    );
  232.  
  233. %attributeFormat =
  234. (
  235.  'ALIGN',     'BOTTOM|MIDDLE|TOP|LEFT|CENTER|RIGHT|JUSTIFY|'.
  236.               'BLEEDLEFT|BLEEDRIGHT|DECIMAL',
  237.  'COLS',      '\d+',
  238.  'COLSPAN',   '\d+',
  239.  'HEIGHT',    '\d+',
  240.  'INDENT',    '\d+',
  241.  'MAXLENGTH', '\d+',
  242.  'METHOD',    'GET|POST',
  243.  'ROWS',      '\d+',
  244.  'ROWSPAN',   '\d+',
  245.  'SEQNUM',    '\d+',
  246.  'SIZE',      '\d+|\d+,\d+',
  247.  'SKIP',      '\d+',
  248.  'TYPE',      'CHECKBOX|HIDDEN|IMAGE|PASSWORD|RADIO|RESET|SUBMIT|TEXT',
  249.  'UNITS',     'PIXELS|EN',
  250.  'VALIGN',    'TOP|MIDDLE|BOTTOM|BASELINE',
  251.  'WIDTH',     '\d+',
  252.  'WRAP',      'OFF|VIRTUAL|PHYSICAL',
  253.  'X',         '\d+',
  254.  'Y',         '\d+'
  255. );
  256.  
  257. %netscapeAttributes =
  258. (
  259.  'A',        'TARGET',
  260.  'AREA',     'SHAPE|HREF|COORDS|NOHREF|TARGET',
  261.  'BASE',     'TARGET',
  262.  'BASEFONT', 'SIZE',
  263.  'BODY',     'BGCOLOR|TEXT|LINK|VLINK|ALINK',
  264.  'FONT',     'COLOR|SIZE',
  265.  'FORM',     'ENCTYPE|TARGET',
  266.  'FRAME',    'SRC|NAME|MARGINWIDTH|MARGINHEIGHT|SCROLLING|NORESIZE',
  267.  'FRAMESET', 'ROWS|COLS',
  268.  'HR',       'SIZE|WIDTH|ALIGN|NOSHADE',
  269.  'IMG',      'BORDER|VSPACE|HSPACE|LOWSRC|USEMAP',
  270.  'ISINDEX',  'PROMPT',
  271.  'LI',       'TYPE|VALUE',
  272.  'MAP',      'NAME',
  273.  'OL',       'TYPE|START',
  274.  'SCRIPT',   'LANGUAGE',
  275.  'TABLE',    'CELLSPACING|CELLPADDING',
  276.  'TEXTAREA', 'WRAP',
  277.  'TD',       'WIDTH',
  278.  'TH',       'WIDTH',
  279.  'UL',       'TYPE'
  280. );
  281.  
  282. %mustFollow =
  283. (
  284.  'LH',       'UL|OL|DL',
  285.  'OVERLAY',  'FIG',
  286.  'HEAD',     'HTML',
  287.  'BODY',     '/HEAD',
  288.  'FRAMESET', '/HEAD',
  289.  '/HTML',    '/BODY|/FRAMESET',
  290.  );
  291.  
  292. %badTextContext =
  293. (
  294.  'HEAD',  'BODY, or TITLE perhaps',
  295.  'UL',    'LI or LH',
  296.  'OL',    'LI or LH',
  297.  'DL',    'DT or DD',
  298.  'TABLE', 'TD or TH',
  299.  'TR',    'TD or TH'
  300. );
  301.  
  302. %variable =
  303. (
  304.  'directory-index',    'index.html',
  305.  'url-get',        '',
  306.  'message-style',    'lint'
  307. );
  308.  
  309. @options = ('d=s', 'e=s', 'stderr', 'help', 'i', 'l', 's', 't', 'todo', 'U',
  310.         'pedantic', 'urlget=s', 'v', 'version', 'warnings', 'x=s');
  311.  
  312. $exit_status = 0;
  313.  
  314. require 'find.pl';
  315.  
  316. &ReadDefaults();
  317. &GetConfigFile();
  318.  
  319. # pedantic command-line switch turns on all warnings except case checking
  320. if ($opt_pedantic)
  321. {
  322.    foreach $warning (keys %enabled)
  323.    {
  324.       &enableWarning($warning, 1);
  325.    }
  326.    &enableWarning('lower-case', 0);
  327.    &enableWarning('upper-case', 0);
  328.    &enableWarning('bad-link', 0);
  329.    &enableWarning('require-doctype', 0);
  330. }
  331.  
  332. &AddExtension("\L$opt_x")             if $opt_x;
  333. $variable{'message-style'} = 'short'  if $opt_s;
  334. $variable{'message-style'} = 'terse'  if $opt_t;
  335. $variable{'url-get'} = $opt_urlget    if $opt_urlget;
  336. *WARNING = *STDERR                    if $opt_stderr;
  337. &ListWarnings()                      if $opt_warnings;
  338.  
  339. # WARNING file handle is default
  340. select(WARNING);
  341.  
  342. $opt_l = 1                 if $ignore{'SYMLINKS'};
  343.  
  344. # -d to disable warnings
  345. if ($opt_d)
  346. {
  347.    for (split(/,/,$opt_d))
  348.    {
  349.       &enableWarning($_, 0);
  350.    }
  351. }
  352.  
  353. # -e to enable warnings
  354. if ($opt_e)
  355. {
  356.    for (split(/,/,$opt_e))
  357.    {
  358.       &enableWarning($_, 1) || next;
  359.    }
  360. }
  361.  
  362. # -i option to ignore case in element tags
  363. if ($opt_i)
  364. {
  365.    $enabled{'lower-case'} = $enabled{'upper-case'} = 0;
  366. }
  367.  
  368. if (defined $variable{'directory-index'})
  369. {
  370.    @dirIndices = split(/\s*,\s*/, $variable{'directory-index'});
  371. }
  372.  
  373. $argc = int(@ARGV);
  374. while (@ARGV > 0)
  375. {
  376.    $arg = shift(@ARGV);
  377.  
  378.    &CheckURL($arg), next if $arg =~ m!^(http|gopher|ftp)://!;
  379.  
  380.    &find($arg), next if -d $arg;
  381.  
  382.    if ($opt_l && -l $arg && $argc == 1)
  383.    {
  384.       warn "$PROGRAM: $arg is a symlink, but I'll check it anyway\n";
  385.    }
  386.  
  387.    &WebLint($arg), next if (-f $arg && -r $arg) || $arg eq '-';
  388.  
  389.    print "$PROGRAM: could not read $arg: $!\n";
  390. }
  391.  
  392. exit $exit_status;
  393.  
  394. #========================================================================
  395. # Function:    WebLint
  396. # Purpose:    This is the high-level interface to the checker.  It takes
  397. #        a file and checks for fluff.
  398. #========================================================================
  399. sub WebLint
  400. {
  401.    local($filename,$relpath) = @_;
  402.    local(@tags) = ();
  403.    local($tagRE) = ('');
  404.    local(@taglines) = ();
  405.    local(@orphans) = ();
  406.    local(@orphanlines) = ();
  407.    local(%seenPage);
  408.    local(%seenTag);
  409.    local(%whined);
  410.    local(*PAGE);
  411.    local($line) = ('');
  412.    local($id, $ID);
  413.    local($tag, $tagNum);
  414.    local($closing);
  415.    local($tail);
  416.    local(%args);
  417.    local($arg);
  418.    local($rest);
  419.    local($lastNonTag);
  420.    local(@notSeen);
  421.    local($seenMailtoLink) = (0);
  422.    local($matched);
  423.    local($matchedLine);
  424.    local($novalue);
  425.    local($heading);
  426.    local($headingLine);
  427.    local($commentline);
  428.    local($_);
  429.  
  430.  
  431.    if ($filename eq '-')
  432.    {
  433.       *PAGE = *STDIN;
  434.       $filename = 'stdin';
  435.    }
  436.    else
  437.    {
  438.       return if defined $seenPage{$filename};
  439.       if (-d $filename)
  440.       {
  441.      print "$PROGRAM: $filename is a directory.\n";
  442.      $exit_status = 0;
  443.      return;
  444.       }
  445.       $seenPage{$filename}++;
  446.       open(PAGE,"<$filename") || do
  447.       {
  448.      print "$PROGRAM: could not read file $filename: $!\n";
  449.      $exit_status = 0;
  450.      return;
  451.       };
  452.       $filename = $relpath if defined $relpath;
  453.    }
  454.  
  455.    undef $heading;
  456.    $tagNum = 0;
  457.  
  458.  READLINE:
  459.    while (<PAGE>)
  460.    {
  461.       $line .= $_;
  462.       $line =~ s/\n/ /g;
  463.  
  464.       while ($line =~ /</o)
  465.       {
  466.      $tail = $'; #'
  467.      undef $lastNonTag;
  468.      if ($` !~ /^\s*$/o)
  469.      {
  470.         $lastNonTag = $`;
  471.  
  472.         # check for illegal text context
  473.         if (defined $badTextContext{$tags[$#tags]})
  474.         {
  475.            &whine($., 'bad-text-context',$tags[$#tags],
  476.               $badTextContext{$tags[$#tags]});
  477.         }
  478.  
  479.         if ($lastNonTag =~ />/)
  480.         {
  481.            &whine($., 'literal-metacharacter', '>', '>')
  482.         }
  483.      }
  484.  
  485.      #--------------------------------------------------------
  486.      #== SGML comment: <!-- ... blah blah ... -->
  487.      #--------------------------------------------------------
  488.      if ($tail =~ /^!--/o)
  489.      {
  490.  
  491.         $commentline = $. unless defined $commentline;
  492.  
  493.         # push lastNonTag onto word list for spell checking
  494.  
  495.         $ct = $';
  496.         next READLINE unless $ct =~ /--\s*>/o;
  497.  
  498.         undef $commentline;
  499.  
  500.         $comment = $`;
  501.         $line = $';
  502.  
  503.         # markup embedded in comment can confuse some (most? :-) browsers
  504.         &whine($., 'markup-in-comment') if $comment =~ /<\s*[^>]+>/o;
  505.         next;
  506.      }
  507.      undef $commentline;
  508.  
  509.      next READLINE unless $tail =~ /^(\s*)([^>]*)>/;
  510.  
  511.  
  512.      &whine($., 'leading-whitespace', $2) if $1 ne '';
  513.  
  514.          $id = $tag = $2;
  515.          $line = $';
  516.  
  517.          &whine($., 'unknown-element', $id),next if $id =~ /^\s*$/;
  518.  
  519.      # push lastNonTag onto word list for spell checking
  520.  
  521.          undef $tail;
  522.          undef $closing;
  523.  
  524.          #-- <!DOCTYPE ... > is ignored for now.
  525.          $seenTag{'DOCTYPE'}=1,next if $id =~ /^!doctype/io;
  526.  
  527.          if (!$whined{'require-doctype'} && !$seenTag{'DOCTYPE'})
  528.      {
  529.             &whine($., 'require-doctype');
  530.             $whined{'require-doctype'} = 1;
  531.      }
  532.  
  533.      $closing = 0;
  534.          if ($id =~ m@^/@o)
  535.          {
  536.             $id =~ s@^/@@;
  537.         $ID = "\U$id";
  538.             $closing = 1;
  539.          }
  540.  
  541.      &CheckAttributes();
  542.  
  543.      $TAG = ($closing ? '/' : '').$ID;
  544.      if (defined $mustFollow{$TAG})
  545.      {
  546.         $ok = 0;
  547.         foreach $pre (split(/\|/, $mustFollow{$TAG}))
  548.         {
  549.            ($ok=1),last if $pre eq $lastTAG;
  550.         }
  551.         if (!$ok || $lastNonTag !~ /^\s*$/)
  552.         {
  553.            &whine($., 'must-follow', $TAG, $mustFollow{$TAG});
  554.         }
  555.      }
  556.  
  557.      #-- catch empty container elements
  558.      if ($closing && $ID eq $lastTAG && $lastNonTag =~ /^\s*$/
  559.          && $tagNums[$#tagNums] == ($tagNum - 1)
  560.          && $ID ne 'TEXTAREA')
  561.      {
  562.         &whine($., 'empty-container', $ID);
  563.      }
  564.  
  565.      #-- special case for empty optional container elements
  566.      if (!$closing && $ID eq $tags[$#tags] && $lastTAG eq $ID
  567.          && $ID =~ /^($maybePaired)$/
  568.          && $tagNums[$#tagNums] == ($tagNum - 1)
  569.          && $lastNonTag =~ /^\s*$/)
  570.      {
  571.         $t = pop @tags;
  572.         $tline = pop @taglines;
  573.         pop @tagNums;
  574.         &whine($tline, 'empty-container', $ID);
  575.         $tagRE = join('|',@tags);
  576.      }
  577.  
  578.          #-- whine about unrecognized element, and do no more checks ----
  579.          if ($id !~ /^($legalElements)$/io)
  580.      {
  581.         if ($id =~ /^($netscapeElements)$/io)
  582.         {
  583.            &whine($., 'netscape-markup', ($closing ? "/$id" : "$id"));
  584.         }
  585.         else
  586.         {
  587.            &whine($., 'unknown-element', ($closing ? "/$id" : "$id"));
  588.         }
  589.         next;
  590.      }
  591.  
  592.          if ($closing == 0 && defined $requiredAttributes{$ID})
  593.          {
  594.         @argkeys = keys %args;
  595.         foreach $attr (split(/\|/,$requiredAttributes{$ID}))
  596.         {
  597.            unless (defined $args{$attr})
  598.            {
  599.           &whine($., 'required-attribute', $attr, $id);
  600.            }
  601.         }
  602.          }
  603.          elsif ($closing == 0 && $id =~ /^($expectArgsRE)$/io)
  604.          {
  605.             &whine($., 'expected-attribute', $id) unless defined %args;
  606.          }
  607.  
  608.          #--------------------------------------------------------
  609.          #== check case of tags
  610.          #--------------------------------------------------------
  611.          &whine($., 'upper-case', $id) if $id ne $ID;
  612.          &whine($., 'lower-case', $id) if $id ne "\L$id";
  613.  
  614.  
  615.          #--------------------------------------------------------
  616.          #== if tag id is /foo, then strip slash, and mark as a closer
  617.          #--------------------------------------------------------
  618.          if ($closing)
  619.          {
  620.         if ($ID !~ /^($pairElements)$/o)
  621.         {
  622.            &whine($., 'illegal-closing', $id);
  623.         }
  624.  
  625.             if ($ID eq 'A' && $lastNonTag =~ /^\s*here\s*$/io)
  626.             {
  627.                &whine($., 'here-anchor');
  628.             }
  629.  
  630.         #-- end of HEAD, did we see a TITLE in the HEAD element? ----
  631.         &whine($., 'require-head') if $ID eq 'HEAD' && !$seenTag{'TITLE'};
  632.  
  633.         #-- was there a <LINK REV=MADE HREF="mailto:.."> element in HEAD?
  634.         &whine($., 'mailto-link') if $ID eq 'HEAD' && $seenMailtoLink == 0;
  635.          }
  636.          else
  637.          {
  638.             #--------------------------------------------------------
  639.             # do context checks.  Should really be a state machine.
  640.             #--------------------------------------------------------
  641.  
  642.         if (defined $physicalFontElements{$ID})
  643.         {
  644.            &whine($., 'physical-font', $ID, $physicalFontElements{$ID});
  645.         }
  646.  
  647.             if ($ID eq 'A' && defined $args{'HREF'})
  648.             {
  649.            $target = $args{'HREF'};
  650.                if ($target =~ /([^:]+):\/\/([^\/]+)(.*)$/
  651.            || $target =~ /^(news|mailto):/
  652.            || $target =~ /^\//)
  653.                {
  654.                }
  655.                else
  656.                {
  657.           $target =~ s/#.*$//;
  658.           if ($target !~ /^\s*$/ && ! -f $target && ! -d $target)
  659.           {
  660.              &whine($., 'bad-link', $target);
  661.           }
  662.                }
  663.             }
  664.  
  665.             if ($ID =~ /^H(\d)$/o)
  666.         {
  667.                if (defined $heading && $1 - $heading > 1)
  668.                {
  669.               &whine($., 'heading-order', $ID, $heading, $headingLine);
  670.                }
  671.                $heading     = $1;
  672.                $headingLine = $.;
  673.         }
  674.  
  675.         #-- check for mailto: LINK ------------------------------
  676.         if ($ID eq 'LINK' && $args{'REV'} =~ /^made$/io
  677.         && $args{'HREF'} =~ /^mailto:/io)
  678.         {
  679.            $seenMailtoLink = 1;
  680.         }
  681.  
  682.         if (defined $onceOnly{$ID})
  683.         {
  684.            &whine($., 'once-only', $ID, $seenTag{$ID}) if $seenTag{$ID};
  685.         }
  686.             $seenTag{$ID} = $.;
  687.  
  688.             &whine($., 'body-no-head') if $ID eq 'BODY' && !$seenTag{'HEAD'};
  689.  
  690.             if ($ID ne 'HTML' && $ID ne '!DOCTYPE' && !$seenTag{'HTML'}
  691.                 && !$whined{'outer-html'})
  692.             {
  693.                &whine($., 'html-outer');
  694.                $whined{'outer-html'} = 1;
  695.             }
  696.  
  697.         #-- check for illegally nested elements ---------------------
  698.         if ($ID =~ /^($nonNest)$/o && $ID =~ /^($tagRE)$/)
  699.         {
  700.            for ($i=$#tags; $tags[$i] ne $ID; --$i)
  701.            {
  702.            }
  703.            &whine($., 'nested-element', $ID, $taglines[$i]);
  704.         }
  705.  
  706.         &whine($., 'unknown-element', $ID) unless $ID =~ /^($legalElements)$/o;
  707.  
  708.         #--------------------------------------------------------
  709.         # check for tags which have a required context
  710.         #--------------------------------------------------------
  711.         if (defined ($reqCon = $requiredContext{$ID}))
  712.         {
  713.            $ok = 0;
  714.            foreach $context (split(/\|/, $requiredContext{$ID}))
  715.            {
  716.           ($ok=1),last if $context =~ /^($tagRE)$/;
  717.            }
  718.            unless ($ok)
  719.            {
  720.                   &whine($., 'required-context', $ID, $requiredContext{$ID});
  721.            }
  722.         }
  723.  
  724.         #--------------------------------------------------------
  725.         # check for tags which can only appear in the HEAD element
  726.         #--------------------------------------------------------
  727.         if ($ID =~ /^($headTagsRE)$/o && 'HEAD' !~ /^($tagRE)$/)
  728.         {
  729.                &whine($., 'head-element', $ID);
  730.         }
  731.  
  732.         if (! defined $okInHead{$ID} && 'HEAD' =~ /^($tagRE)$/)
  733.         {
  734.                &whine($., 'non-head-element', $ID);
  735.         }
  736.  
  737.         #--------------------------------------------------------
  738.         # check for tags which have been deprecated (now obsolete)
  739.         #--------------------------------------------------------
  740.         &whine($., 'obsolete', $ID) if $ID =~ /^($obsoleteTags)$/o;
  741.          }
  742.  
  743.          #--------------------------------------------------------
  744.          #== was tag of type <TAG> ... </TAG>?
  745.          #== welcome to kludgeville, population seems to be on the increase!
  746.          #--------------------------------------------------------
  747.          if ($ID =~ /^($pairElements)$/o)
  748.          {
  749.         if ($closing)
  750.         {
  751.            # trailing whitespace in content of container element
  752.            if ($lastNonTag =~ /\S\s+$/ && $ID =~ /^($cuddleContainers)$/)
  753.            {
  754.           &whine($., 'container-whitespace', 'trailing', $ID);
  755.            }
  756.  
  757.            #-- if we have a closing tag, and the tag(s) on top of the stack
  758.            #-- are optional closing tag elements, pop the tag off the stack,
  759.            #-- unless it matches the current closing tag
  760.            while (@tags > 0 && $tags[$#tags] ne $ID
  761.               && $tags[$#tags] =~ /^($maybePaired)$/o)
  762.            {
  763.           pop @tags;
  764.           pop @tagNums;
  765.           pop @taglines;
  766.            }
  767.            $tagRE = join('|',@tags);
  768.         }
  769.         else
  770.         {
  771.            # leading whitespace in content of container element
  772.            if ($line =~ /^\s+/ && $ID =~ /^($cuddleContainers)$/)
  773.            {
  774.           &whine($., 'container-whitespace', 'leading', $ID);
  775.            }
  776.         }
  777.  
  778.             if ($closing && $tags[$#tags] eq $ID)
  779.             {
  780.                &PopEndTag();
  781.             }
  782.             elsif ($closing && $tags[$#tags] ne $ID)
  783.             {
  784.            #-- closing tag does not match opening tag on top of stack
  785.            if ($ID =~ /^($tagRE)$/)
  786.            {
  787.           # If we saw </HTML>, </HEAD>, or </BODY>, then we try
  788.           # and resolve anything inbetween on the tag stack
  789.           if ($ID =~ /^(HTML|HEAD|BODY)$/o)
  790.           {
  791.              while ($tags[$#tags] ne $ID)
  792.              {
  793.             $ttag = pop @tags;
  794.             pop @tagNums;
  795.             $ttagline = pop @taglines;
  796.             if ($ttag !~ /^($maybePaired)$/)
  797.             {
  798.                &whine($., 'unclosed-element', $ttag, $ttagline);
  799.             }
  800.  
  801.             #-- does top of stack match top of orphans stack? --
  802.             while (@orphans > 0 && @tags > 0
  803.                    && $orphans[$#orphans] eq $tags[$#tags])
  804.             {
  805.                pop @orphans;
  806.                pop @orphanlines;
  807.                pop @tags;
  808.                pop @tagNums;
  809.                pop @taglines;
  810.             }
  811.              }
  812.  
  813.              #-- pop off the HTML, HEAD, or BODY tag ------------
  814.              pop @tags;
  815.              pop @tagNums;
  816.              pop @taglines;
  817.              $tagRE = join('|',@tags);
  818.           }
  819.           else
  820.           {
  821.              #-- matched opening tag lower down on stack
  822.              push(@orphans, $ID);
  823.              push(@orphanlines, $.);
  824.           }
  825.            }
  826.            else
  827.            {
  828.                   if ($ID =~ /^H[1-6]$/ && $tags[$#tags] =~ /^H[1-6]$/)
  829.                   {
  830.              &whine($., 'heading-mismatch', $tags[$#tags], $ID);
  831.                      &PopEndTag();
  832.                   }
  833.           else
  834.           {
  835.              &whine($., 'mis-match', $ID);
  836.                   }
  837.            }
  838.             }
  839.             else
  840.             {
  841.                push(@tags,$ID);
  842.                $tagRE = join('|',@tags);
  843.                push(@tagNums,$tagNum);
  844.                push(@taglines,$.);
  845.             }
  846.          }
  847.  
  848.          #--------------------------------------------------------
  849.          #== inline images (IMG) should have an ALT argument :-)
  850.          #--------------------------------------------------------
  851.          &whine($., 'img-alt') if ($ID eq 'IMG'
  852.                    && !defined $args{'ALT'}
  853.                    && !$closing);
  854.  
  855.          #--------------------------------------------------------
  856.          #== WIDTH & HEIGHT on inline images (IMG) can help browsers
  857.          #--------------------------------------------------------
  858.          &whine($., 'img-size') if ($ID eq 'IMG'
  859.                    && !defined $args{'WIDTH'}
  860.                    && !defined $args{'HEIGHT'}
  861.                    && !$closing);
  862.  
  863.       } continue {
  864.      $lastTagNum = $tagNum;
  865.      ++$tagNum;
  866.          $lastTAG = $TAG;
  867.       }
  868.       $lastNonTag = $line;
  869.    }
  870.    close PAGE;
  871.  
  872.    if (defined $commentline)
  873.    {
  874.       &whine($commentline, 'unclosed-comment');
  875.       return;
  876.    }
  877.  
  878.    while (@tags > 0)
  879.    {
  880.       $tag = shift(@tags);
  881.       shift(@tagNums);
  882.       $line = shift(@taglines);
  883.       if ($tag !~ /^($maybePaired)$/)
  884.       {
  885.      &whine($., 'unclosed-element', $tag, $line);
  886.       }
  887.    }
  888.  
  889.    for (@expectedTags)
  890.    {
  891.       # if we haven't seen TITLE but have seen HEAD
  892.       # then we'll have already whined about the lack of a TITLE element
  893.       next if $_ eq 'TITLE' && !$seenTag{$_} && $seenTag{'HEAD'};
  894.       next if $_ eq 'BODY' && $seenTag{'FRAMESET'};
  895.       push(@notSeen,$_) unless $seenTag{$_};
  896.    }
  897.    if (@notSeen > 0)
  898.    {
  899.       printf ("%sexpected tag(s) not seen: @notSeen\n",
  900.               ($opt_s ? "" : "$filename(-): "));
  901.       $exit_status = 1;
  902.    }
  903. }
  904.  
  905. #========================================================================
  906. # Function:    ReadDefaults
  907. # Purpose:    Read the built-in defaults.  These are stored at the end
  908. #               of the script, after the __END__, and read from the
  909. #               DATA filehandle.
  910. #========================================================================
  911. sub ReadDefaults
  912. {
  913.    local(@elements);
  914.  
  915.  
  916.    while (<DATA>)
  917.    {
  918.       chop;
  919.       s/^\s*//;
  920.       next if /^$/;
  921.  
  922.       push(@elements, $_);
  923.  
  924.       next unless @elements == 3;
  925.  
  926.       ($id, $default, $message) = @elements;
  927.       $enabled{$id} = ($default eq 'ENABLE');
  928.       ($message{$id} = $message) =~ s/"/\\"/g;
  929.       undef @elements;
  930.    }
  931. }
  932.  
  933. __END__
  934. upper-case
  935.     DISABLE
  936.     tag <$argv[0]> is not in upper case.
  937. lower-case
  938.     DISABLE
  939.     tag <$argv[0]> is not in lower case.
  940. mixed-case
  941.     ENABLE
  942.     tag case is ignored
  943. here-anchor
  944.     ENABLE
  945.     bad form to use `here' as an anchor!
  946. require-head
  947.     ENABLE
  948.     no <TITLE> in HEAD element.
  949. once-only
  950.     ENABLE
  951.     tag <$argv[0]> should only appear once.  I saw one on line $argv[1]!
  952. body-no-head
  953.     ENABLE
  954.     <BODY> but no <HEAD>.
  955. html-outer
  956.     ENABLE
  957.     outer tags should be <HTML> .. </HTML>.
  958. head-element
  959.     ENABLE
  960.     <$argv[0]> can only appear in the HEAD element.
  961. non-head-element
  962.     ENABLE
  963.     <$argv[0]> cannot appear in the HEAD element.
  964. obsolete
  965.     ENABLE
  966.     <$argv[0]> is obsolete.
  967. mis-match
  968.     ENABLE
  969.     unmatched </$argv[0]> (no matching <$argv[0]> seen).
  970. img-alt
  971.     ENABLE
  972.     IMG does not have ALT text defined.
  973. nested-element
  974.     ENABLE
  975.     <$argv[0]> cannot be nested -- </$argv[0]> not yet seen for <$argv[0]> on line $argv[1].
  976. mailto-link
  977.     DISABLE
  978.     did not see <LINK REV=MADE HREF="mailto..."> in HEAD.
  979. element-overlap
  980.     ENABLE
  981.     </$argv[0]> on line $argv[1] seems to overlap <$argv[2]>, opened on line $argv[3].
  982. unclosed-element
  983.     ENABLE
  984.     no closing </$argv[0]> seen for <$argv[0]> on line $argv[1].
  985. markup-in-comment
  986.     ENABLE
  987.     markup embedded in a comment can confuse some browsers.
  988. unknown-attribute
  989.     ENABLE
  990.     unknown attribute "$argv[1]" for element <$argv[0]>.
  991. leading-whitespace
  992.     ENABLE
  993.     should not have whitespace between "<" and "$argv[0]>".
  994. required-attribute
  995.     ENABLE
  996.     the $argv[0] attribute is required for the <$argv[1]> element.
  997. unknown-element
  998.     ENABLE
  999.     unknown element <$argv[0]>.
  1000. odd-quotes
  1001.     ENABLE
  1002.     odd number of quotes in element <$argv[0]>.
  1003. heading-order
  1004.     ENABLE
  1005.     bad style - heading <$argv[0]> follows <H$argv[1]> on line $argv[2].
  1006. bad-link
  1007.     DISABLE
  1008.     target for anchor "$argv[0]" not found.
  1009. expected-attribute
  1010.     ENABLE
  1011.     expected an attribute for <$argv[0]>.
  1012. unexpected-open
  1013.     ENABLE
  1014.     unexpected < in <$argv[0]> -- potentially unclosed element.
  1015. required-context
  1016.     ENABLE
  1017.     illegal context for <$argv[0]> - must appear in <$argv[1]> element.
  1018. unclosed-comment
  1019.     ENABLE
  1020.     unclosed comment (comment should be: <!-- ... -->).
  1021. illegal-closing
  1022.     ENABLE
  1023.     element <$argv[0]> is not a container -- </$argv[0]> not legal.
  1024. netscape-markup
  1025.     ENABLE
  1026.     <$argv[0]> is netscape specific (use "-x netscape" to allow this).
  1027. netscape-attribute
  1028.     ENABLE
  1029.     attribute `$argv[0]' for <$argv[1]> is netscape specific (use "-x netscape" to allow this).
  1030. physical-font
  1031.     DISABLE
  1032.     <$argv[0]> is physical font markup -- use logical (such as $argv[1]).
  1033. repeated-attribute
  1034.     ENABLE
  1035.     attribute $argv[0] is repeated in element <$argv[1]>
  1036. must-follow
  1037.     ENABLE
  1038.     <$argv[0]> must immediately follow <$argv[1]>
  1039. empty-container
  1040.     ENABLE
  1041.     empty container element <$argv[0]>.
  1042. directory-index
  1043.     ENABLE
  1044.     directory does not have an index file ($argv[0])
  1045. closing-attribute
  1046.     ENABLE
  1047.     closing tag <$argv[0]> should not have any attributes specified.
  1048. attribute-delimiter
  1049.     ENABLE
  1050.     use of ' for attribute value delimiter is not supported by all browsers (attribute $argv[0] of tag $argv[1])
  1051. img-size
  1052.     DISABLE
  1053.     setting WIDTH and HEIGHT attributes on IMG tag can improve rendering performance on some browsers.
  1054. container-whitespace
  1055.     DISABLE
  1056.     $argv[0] whitespace in content of container element $argv[1]
  1057. require-doctype
  1058.     DISABLE
  1059.     first element was not DOCTYPE specification
  1060. literal-metacharacter
  1061.     ENABLE
  1062.     metacharacter '$argv[0]' should be represented as '$argv[1]'
  1063. heading-mismatch
  1064.     ENABLE
  1065.     malformed heading - open tag is <$argv[0]>, but closing is </$argv[1]>
  1066. bad-text-context
  1067.     ENABLE
  1068.     illegal context, <$argv[0]>, for text; should be in $argv[1].
  1069. attribute-format
  1070.     ENABLE
  1071.     illegal value for $argv[0] attribute of $argv[1] ($argv[2])
  1072.