home *** CD-ROM | disk | FTP | other *** search
/ HTML - Publishing on the Internet / html_cdrom.iso / tools / html / linux / check / dehtml.pl < prev    next >
Encoding:
Perl Script  |  1995-01-18  |  5.6 KB  |  130 lines
  1. #!/usr/local/bin/perl
  2. #dehtml.pl: Removes all HTML tags from file, preliminary to spell check; common
  3. #           ampersand "&entities;" are also resolved into single characters.
  4. #
  5. # Typical use:
  6. #
  7. #   perl dehtml.pl infile.html > outfile.txt
  8. #
  9. # This program processes all files on the command line to STDOUT; to process a
  10. # number of files individually, use the iteration mechanism of your shell; for
  11. # example:
  12. #
  13. #    for a in *.html ; do perl dehtml.pl $a > otherdir/$a ; done
  14. #
  15. # in Unix sh, or:
  16. #
  17. #    for %a in (*.htm) do call dehtml %a otherdir\%a
  18. #
  19. # in MS-DOS, where dehtml.bat is the following one-line batch file:
  20. #
  21. #    perl dehtml.pl %1 > %2
  22. #
  23. # Copyright H. Churchyard 1994 -- freely redistributable.
  24. #
  25. #  Version 1.0 11/27/94 -- Tested with 4.03[56] on SunOS and DEC Alpha OSF/1,
  26. # and MacPerl 4.13.  Included in htmlchek 3.0 release.
  27. #  Version 1.1 12/6/94 -- Fixed minor bug which could unpredictably cause a
  28. # string such as "&eacute;" to be reduced into a single character;
  29. # added "­".   Included in htmlchek 3.01 release.
  30. #  Version 1.2 1/12/95 -- No error on `>' outside tag; minor bugfix.  Included
  31. # in htmlchek 4.0 release.
  32. #
  33. #   This program is a port to perl of the original dehtml.awk (the port was
  34. # fairly mechanical, so programming style and efficency may not be high).
  35. #
  36. eval "exec /usr/local/bin/perl -S $0 $*"
  37.     if $running_under_some_shell;
  38.                         # this emulates #! processing on NIH machines.
  39. $[ = 1;                 # set array base to 1
  40. $, = ' ';               # set output field separator
  41. $\ = "\n";              # set output record separator
  42. #
  43. $amp{' '} = "\040"; $amp{' '}="\040";
  44. $amp{'"'} = "\042"; $amp{'"'}="\042";
  45. $amp{'<'} = "\074"; $amp{'<'}="\074"; $amp{'>'} = "\076";
  46. $amp{'>'}="\076"; $amp{'À'}="\300"; $amp{'Á'}="\301";
  47. $amp{'Â'}="\302"; $amp{'Ã'}="\303"; $amp{'Ä'}="\304";
  48. $amp{'Å'}="\305"; $amp{'Æ'}="\306"; $amp{'Ç'}="\307";
  49. $amp{'È'}="\310"; $amp{'É'}="\311"; $amp{'Ê'}="\312";
  50. $amp{'Ë'}="\313"; $amp{'Ì'}="\314"; $amp{'Í'}="\315";
  51. $amp{'Î'}="\316"; $amp{'Ï'}="\317"; $amp{'Ð'}="\320";
  52. $amp{'Ñ'}="\321"; $amp{'Ò'}="\322"; $amp{'Ó'}="\323";
  53. $amp{'Ô'}="\324"; $amp{'Õ'}="\325"; $amp{'Ö'}="\326";
  54. $amp{'Ø'}="\330"; $amp{'Ù'}="\331"; $amp{'Ú'}="\332";
  55. $amp{'Û'}="\333"; $amp{'Ü'}="\334"; $amp{'Ý'}="\335";
  56. $amp{'Þ'}="\336"; $amp{'ß'}="\337"; $amp{'à'}="\340";
  57. $amp{'á'}="\341"; $amp{'â'}="\342"; $amp{'ã'}="\343";
  58. $amp{'ä'}="\344"; $amp{'å'}="\345"; $amp{'æ'}="\346";
  59. $amp{'ç'}="\347"; $amp{'è'}="\350"; $amp{'é'}="\351";
  60. $amp{'ê'}="\352"; $amp{'ë'}="\353"; $amp{'ì'}="\354";
  61. $amp{'í'}="\355"; $amp{'î'}="\356"; $amp{'ï'}="\357";
  62. $amp{'ð'}="\360"; $amp{'ñ'}="\361"; $amp{'ò'}="\362";
  63. $amp{'ó'}="\363"; $amp{'ô'}="\364"; $amp{'õ'}="\365";
  64. $amp{'ö'}="\366"; $amp{'ø'}="\370"; $amp{'ù'}="\371";
  65. $amp{'ú'}="\372"; $amp{'û'}="\373"; $amp{'ü'}="\374";
  66. $amp{'ý'}="\375"; $amp{'þ'}="\376"; $amp{'ÿ'}="\377";
  67. $amp{'®'}="\256"; $amp{'©'}="\251"; $amp{'£'} = "\243";
  68. $amp{'­'}="-";
  69. #
  70. # Main
  71. #
  72. # Variable ``$state'' is one if unresolved `<', zero otherwise.
  73. #
  74. $stuperlRS = $/;
  75. while (<>) {
  76.     if ($_ =~ /$stuperlRS$/o) { # strip record separator, allow for last line to
  77.         chop;}                  # be unterminated.
  78.     $line = ''; $errstr = ''; $erra = 0; $errb = 0;
  79.     $currsrch = 1; $txtbeg = 1;
  80.     while ((((substr($_, $currsrch) =~ /[<>]/) eq 1) &&
  81.       ($RSTART = length($`)+1)) != 0) {
  82.         $currsrch = ($currsrch + $RSTART);
  83.         if (substr($_, ($currsrch - 1), 1) eq '<') {
  84.             if ($state) {
  85.                 if (!$erra) {
  86.                     $errstr = ($errstr .
  87.                       "&&^Multiple `<' without `>' ERROR!, Ignoring^&&\n");
  88.                     $erra = 1;}}
  89.             else {
  90.                 if (($currsrch > length($_)) ||
  91.                   (substr($_, $currsrch, 1) =~ /^[ \t]$/)) {
  92.                     if (!$errb) {
  93.                         $errstr = ($errstr .
  94.                           "&&^Whitespace after `<': Bad SGML syntax ERROR!, Ignoring^&&\n");
  95.                         $errb = 1;}}
  96.                 else {
  97.                     if ($currsrch > ($txtbeg + 1)) {
  98.                         $line = ($line . substr($_, $txtbeg,
  99.                           ($currsrch - ($txtbeg + 1))));}
  100.                     $state = 1;}}}
  101.         else {
  102.             if (substr($_, ($currsrch - 1), 1) eq '>') {
  103.                 if ($state == 0) {
  104.                     next;}
  105.                 else {$txtbeg = $currsrch; $state = 0;}}
  106.             else {print 'Internal error, ignore';}}}
  107. #At EOL:
  108.     if ((!$state) && ($txtbeg <= length($_))) {
  109.         $line = ($line . substr($_, $txtbeg));}
  110.     if ($line =~ /&#?[-0-9a-zA-Z.]*;/) {
  111.         foreach $X (keys %amp) {
  112.             $s_ = $amp{$X}; $line =~ s/$X/$s_/g;
  113.             if ($line !~ /&/) {
  114.                 last;}}
  115.         $line =~ s/&(#38|amp);/&/g;}
  116.     if (($line) || ((!$state) && ($_ =~ /^$/))) {
  117.         if ((!$state) || ($errstr) || ($line =~ /[ \t]$/))
  118.             {print $line;}
  119.         else {printf "%s", $line;}}
  120.     if ($errstr) {
  121.         printf '%s', $errstr;}}
  122. #
  123. #Minor bug: &g<X>t; will translate to a `>' character!
  124. #
  125. #END routine:
  126. #
  127. if ($state) {
  128.     print "&&^Was awaiting a `>' ERROR! at END^&&";}
  129. ##EOF
  130.