🚀 go-pugleaf

Michael.Grabenstein@gsfc.nasa.go writes:
| 	What I need to do is go through a text file and strip all the HTML
| tags from it.
| 	I could write this, but if someone has already saved me the
| time...Where can I ftp such a utility from?

Try this. It expects tags not to be broken over newlines, but is otherwise ok.
	- Cameron Simpson
	  cameron@cse.unsw.edu.au, DoD#743
--
Plague, Famine, Pestilence, and C++ stalk the land. We're doomed! Doomed!
	- Simon E Spero

#!/bin/sh
#

mkdir cameron && cd cameron && mkdir cs || exit $?

sed 's/^X//' > 'unhtml' <<'EOF-unhtml'
X#!/usr/local/bin/perl
X#
X
Xrequire 'cs/html.pl';
X
Xwhile (<>)
X	{ print &html'html2raw($_);
X	}
EOF-unhtml

sed 's/^X//' > 'cs/html.pl' <<'EOF-cs/html.pl'
X#!/usr/local/bin/perl
X#
X# HTML/SGML-related stuff.	- Cameron Simpson, <cameron@cse.unsw.edu.au>
X#
X
Xpackage html;
X
Xundef %special_ch, %special_code;
X$codeptn='';
X@chlist=();
X$chrange='';
X
X{ local(@specials)=(	'amp',	'&',	# & must be first
X			'lt',	'<',
X			'gt',	'>'
X		   );
X  local($code,$ch);
X
X  while (defined($code=shift @specials)
X      && defined($ch  =shift @specials))
X	{ $special_ch{$code}=$ch;
X	  $special_code{$ch}=$code;
X	  push(@chlist,$ch);
X	  $chrange.=$ch;
X	  $codeptn.='|'.$code;
X	}
X
X  $codeptn =~ s/^\|//;
X}
X
X# pattern to match =val ==> $1=val
X$annoattrvalptn='\s*=\s*([^">]+|"[^"]+")';
X
X# pattern to match attr[=val] ==> $1=attr $3=val(if present)
X$annoattrptn='\s+(\w+)('.$annoattrvalptn.')?';
X
X# pattern to match attr=val ==> $1=attr $2=val
X$annoattrvalptn='\s+(\w+)'.$annoattrvalptn;
X
X# pattern to match an annotation marker ==> $1=type $2=parameters
X$annoptn='<\s*(/?\s*\w+)(('.$annoattrptn.')*)\s*>';
X
X# pattern to match an URL ==> $1=URL, $2=tag
X$urlptn='<\s*a\s+href'.$annoattrvalptn.'\s*>\s*([^<]*[^<\s])\s*<\s*/\s*a>';
X
X# pattern to match an RFC822 Message-ID
X$msgidptn='<[^>@]*@[^>@]*>';
X
Xsub raw2html	# rawline -> escaped line
X	{ local($_)=@_;
X
X	  # convert special characters
X	  s:(_)+([&<>]):$2:g;	# clear underlines from specials
X	  s:(([&<>]))+\2:$2:g;# clear bold from specials
X	  s:&:&amp;:g;		# replace with SGML escapes
X	  s:<:&lt;:g;
X	  s:>:&gt;:g;
X
X	  # recognise bold (accomodating underlined bold!)
X	  s:((_)*(.)(\3)+)+:<b>$&</b>:g;
X	  s:(.)(\1)+:$1:g;
X
X	  # recognise italics
X	  s:((_)+.)+:<i>$&</i>:g;
X	  s:(_)+(.):$2:g;
X
X	  $_;
X	}
X
Xsub html2raw	# html ==> line without HTML annotation
X	{ local($_)=@_;
X
X	  # remode HTML markup
X	  s/$annoptn//og;
X
X	  # decode special &code; escapes
X	  s/\&($codeptn);?/$special_ch{$1}/og;
X
X	  $_;
X	}
X
Xsub href	# (tag,url) -> <A HREF=...>...</A>
X	{ local($tag,$url)=@_;
X
X	  '<A HREF="'.&quote($url).'">'.&raw2html($tag).'</A>';
X	}
X
X
Xsub news2html
X	{ local($_)=@_;
X
X	  local($sofar);
X
X	  while (length)
X		{ if (/^$annoptn/o
X		   || /^\&\w+;/)	{ $sofar.=$&; $_=$'; }
X		  elsif (/^$msgidptn/o)	{ $sofar.=&msgid2html($&); $_=$'; }
X		  elsif (m;^\w+\://[^"\s]+;){ $sofar.=&href($&,$&); $_=$'; }
X		  elsif (/^[^<\w&]+/)	{ $sofar.=$&; $_=$'; }
X		  else
X		  { $sofar.=substr($_,$[,1);
X		    substr($_,$[,1)='';
X		  }
X		}
X
X	  $sofar;
X	}
X
Xsub msgid2html
X	{ local($id)=shift;
X	  local($shortid)=$id;
X
X	  $shortid =~ s/^<(.*)>$/$1/;
X	  &href($id,"news:$shortid");
X	}
X
Xsub quote	# raw -> %xx escaped string
X	{ local($_)=shift;
X	  local($sofar,$match);
X
X	  $sofar='';
X	  LEX:
X	    while (/[-\w:\.\/#?]+|[^-\w:\.\/#?]+/g)
X		{ $match=$&;
X		  next LEX if $match =~ /^[-\w:\.\/]/;
X		  $match =~ s/./sprintf("%%%02x",ord($&))/eg;
X		}
X	    continue
X		{ $sofar.=$match;
X		}
X
X	  if ($sofar ne $_)
X		{ # print STDERR "html'quote($_) ==> ($sofar)\n";
X		}
X
X	  $sofar;
X	}
X
Xsub unquote	# %xx -> raw
X	{ local($_)=shift;
X	  s/\%([\da-f]{2})/sprintf('%c',hex($1))/eig;
X	  $_;
X	}
X
Xsub ifunquote	# ["]quoted["] -> unquoted
X	{ local($_)=shift;
X	  # print STDERR "ifunquote($_) -> ";
X	  s/^"(.*)"$/$1/;
X	  $_=&unquote($_);
X	  # print STDERR "[$_]\n";
X	  $_;
X	}
X
Xsub urls	# html -> (url,tag,...)
X	{ local($_)=@_;
X	  local(@urls,$url,$tag);
X	
X	  while (m:$urlptn:oi)
X		{ ($url,$tag)=($1,$2);
X		  $_=$';
X		  push(@urls,$url,$tag);
X		}
X
X	  @urls;
X	}
X
Xsub annodecode	# "<[/]blah [foo=bar]...>" -> (blah,noslash,foo,bar,...)
X	{ local($_)=shift;
X	  local($type,$start,%attr);
X
X	  return undef unless /^$annoptn/o;
X
X	  $type=$1;
X	  $_=$2;
X
X	  if ($type =~ m:^/\s*:)	{ $start=0; $type=$'; }
X	  else				{ $start=1; }
X
X	  $type =~ tr/A-Z/a-z/;
X
X	  ATTR:
X	    while (1)
X		{ if (/$annoattrvalptn/o) { $attr{$1}=&ifunquote($2); }
X		  elsif (/$annoattrptn/o) { $attr{$1}=undef; }
X		  else			  { last ATTR; }
X
X		  $_=$';
X		}
X
X	  ($type,$start,%attr);
X	}
X1;
EOF-cs/html.pl

exit 0