site/cgi-bin/modules/DevHelp/Formatter.pm

   1 package DevHelp::Formatter;
   2 use strict;
   3 use DevHelp::HTML;
   4 use Carp 'confess';
   5
   6 our $VERSION = "1.003";
   7
   8 use constant DEBUG => 0;
   9
  10 sub new {
  11   my ($class) = @_;
  12
  13   return bless {}, $class;
  14 }
  15
  16 sub embed {
  17   '';
  18 }
  19
  20 sub image {
  21   my ($self, $imagename, $align) = @_;
  22
  23   return '';
  24 }
  25
  26 sub rewrite_url {
  27   my ($self, $url, $type) = @_;
  28
  29   return $url;
  30 }
  31
  32 sub replace {
  33 }
  34
  35 sub _make_hr {
  36   my ($width, $height) = @_;
  37   my $tag = "<hr";
  38   $tag .= qq! width="$width"! if length $width;
  39   $tag .= qq! size="$height"! if length $height;
  40   $tag .= " />";
  41   return $tag;
  42 }
  43
  44 # produces a table, possibly with options for the <table> and <tr> tags
  45 sub _make_table {
  46   my ($options, $text) = @_;
  47   my $tag = "<table";
  48   my $cellend = '';
  49   my $cellstart = '';
  50   if ($options =~ /=/) {
  51     $tag .= " " . unescape_html($options);
  52   }
  53   elsif ($options =~ /\S/) {
  54     $options =~ s/\s+$//;
  55     my ($width, $bg, $pad, $fontsz, $fontface) = split /\|/, $options;
  56     for ($width, $bg, $pad, $fontsz, $fontface) {
  57       $_ = '' unless defined;
  58     }
  59     $tag .= qq! width="$width"! if length $width;
  60     $tag .= qq! bgcolor="$bg"! if length $bg;
  61     $tag .= qq! cellpadding="$pad"! if length $pad;
  62     if (length $fontsz || length $fontface) {
  63       $cellstart = qq!<font!;
  64       $cellstart .= qq! size="$fontsz"! if length $fontsz;
  65       $cellstart .= qq! face="$fontface"! if length $fontface;
  66       $cellstart .= qq!>!;
  67       $cellend = "</font>";
  68     }
  69   }
  70   $tag .= ">";
  71   my @rows = split '\n', $text;
  72   my $maxwidth = 0;
  73   for my $row (@rows) {
  74     my ($opts, @cols) = split /\|/, $row;
  75     $tag .= "<tr";
  76     if (defined $opts && $opts =~ /=/) {
  77       $tag .= " ".unescape_html($opts);
  78     }
  79     $tag .= "><td>$cellstart".join("$cellend</td><td>$cellstart", @cols)
  80       ."$cellend</td></tr>";
  81   }
  82   $tag .= "</table>";
  83   return $tag;
  84 }
  85
  86 # make a UL
  87 sub _format_bullets {
  88   my ($text) = @_;
  89
  90   $text =~ s/^\s+|\s+$//g;
  91   my @points = split /(?:\r?\n)? *\*\*\s*/, $text;
  92   shift @points if @points and $points[0] eq '';
  93   return '' unless @points;
  94   for my $point (@points) {
  95     $point =~ s!\n *$!!
  96       and $point = "<p>$point</p>";
  97   }
  98   return "<ul><li>".join("</li><li>", @points)."</li></ul>";
  99 }
 100
 101 # make a OL
 102 sub _format_ol {
 103   my ($text, $type, $code) = @_;
 104
 105   print STDERR "_format_ol(..., $type, $code)\n" if DEBUG;
 106   print STDERR "text: ",unpack("H*", $text),"\n" if DEBUG;
 107   $text =~ s/^\s+|\s+$//g;
 108   $code ||= "##";
 109   my @points = split /(?:\r?\n)? *$code\s*/, $text;
 110   shift @points if @points and $points[0] eq '';
 111   return '' unless @points;
 112   for my $point (@points) {
 113     $point =~ s!\n *$!!
 114       and $point = "<p>$point</p>";
 115   }
 116   my $ol = "<ol";
 117   $ol .= qq! type="$type"! if $type;
 118   $ol .= ">";
 119   return "$ol<li>".join("</li><li>", @points)."</li></ol>";
 120 }
 121
 122 sub _format_lists {
 123   my ($text) = @_;
 124
 125   my $out = '';
 126
 127   while (length $text) {
 128     if ($text =~ s(^((?: *\#\#[^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*(?:\n *|$)\n?[^\S\n]*)+)\n?)()) {
 129       $out .= _format_ol($1);
 130     }
 131     elsif ($text =~ s(^((?: *\*\*[^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*(?:\n *|$)\n?[^\S\n]*)+)\n?)()) {
 132       $out .= _format_bullets($1);
 133     }
 134     elsif ($text =~ s(^((?: *%%[^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*(?:\n *|$)\n?[^\S\n]*)+)\n?)()) {
 135       $out .= _format_ol($1, 'a', '%%');
 136     }
 137     else {
 138       $out .= $text;
 139       $text = '';
 140     }
 141   }
 142
 143   return $out;
 144 }
 145
 146 # raw html - this has some limitations
 147 # the input text has already been escaped, so we need to unescape it
 148 # too bad if you want [] in your html (but you can use entities)
 149 sub _make_html {
 150   return unescape_html($_[0]);
 151 }
 152
 153 sub _fix_spanned {
 154   my ($self, $start, $end, $text, $type) = @_;
 155
 156   if ($type) {
 157     my $class = $self->tag_class($type);
 158     if ($class) {
 159       $start =~ s/>$/ class="$class">/;
 160     }
 161   }
 162
 163   $text =~ s!(\n(?:[ \r]*\n)+)!$end$1$start!g;
 164
 165   "$start$text$end";
 166 }
 167
 168 sub link {
 169   my ($self, $url, $text) = @_;
 170
 171   $self->_fix_spanned(qq/<a href="/ . $self->rewrite_url($url, $text, "link") . qq/">/, "</a>", $text, 'link')
 172 }
 173
 174 sub replace_char {
 175   my ($self, $rpart) = @_;
 176   $$rpart =~ s#(acronym|abbr|dfn)\[(?:\r?\n)?([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+?)(?:\r?\n)?\]#
 177     $self->_fix_spanned(qq/<$1 class="$3" title="$2">/, "</$1>", $4)#egi
 178     and return 1;
 179   $$rpart =~ s#(acronym|abbr|dfn)\[(?:\r?\n)?([^|\]\[]+)\|([^\]\[]+?)(?:\r?\n)?\]#
 180     $self->_fix_spanned(qq/<$1 title="$2">/, "</$1>", $3)#egi
 181     and return 1;
 182   $$rpart =~ s#(acronym|abbr|dfn)\[(?:\r?\n)?\|([^\]\[]+?)(?:\r?\n)?\]#
 183     $self->_fix_spanned("<$1>", "</$1>", $2)#egi
 184     and return 1;
 185   $$rpart =~ s#(acronym|abbr|dfn)\[(?:\r?\n)?([^\]\[]+?)(?:\r?\n)?\]#
 186     $self->_fix_spanned("<$1>", "</$1>", $2)#egi
 187     and return 1;
 188   $$rpart =~ s#bdo\[(?:\r?\n)?([^|\]\[]+)\|([^\]\[]+?)(?:\r?\n)?\]#
 189     $self->_fix_spanned(qq/<bdo dir="$1">/, "</bdo>", $2)#egi
 190     and return 1;
 191   $$rpart =~ s#(strong|em|samp|code|var|sub|sup|kbd|q|b|i|tt|span)\[(?:\r?\n)?([^|\]\[]+)\|([^\]\[]+?)(?:\r?\n)?\]#
 192     $self->_fix_spanned(qq/<$1 class="$2">/, "</$1>", $3)#egi
 193     and return 1;
 194   $$rpart =~ s#(strong|em|samp|code|var|sub|sup|kbd|q|b|i|tt|span)\[(?:\r?\n)?\|([^\]\[]+?)(?:\r?\n)?\]#
 195     $self->_fix_spanned("<$1>", "</$1>", $2)#egi
 196     and return 1;
 197   $$rpart =~ s#(strong|em|samp|code|var|sub|sup|kbd|q|b|i|tt|span)\[(?:\r?\n)?([^\]\[]+?)(?:\r?\n)?\]#
 198     $self->_fix_spanned("<$1>", "</$1>", $2)#egi
 199     and return 1;
 200   $$rpart =~ s#poplink\[([^|\]\[]+)\|([^\]\[]+)\]#
 201     $self->_fix_spanned(qq/<a href="/ . $self->rewrite_url($1, $2, "poplink") . qq/" target="_blank">/, "</a>", $2, 'poplink')#eig
 202     and return 1;
 203   $$rpart =~ s#poplink\[([^|\]\[]+)\]#
 204     $self->_fix_spanned(qq/<a href="/ . $self->rewrite_url($1, $1, "poplink") . qq/" target="_blank">/, "</a>", $1, 'poplink')#ieg
 205     and return 1;
 206   $$rpart =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#
 207     $self->link($1, $2)#eig
 208     and return 1;
 209   $$rpart =~ s#link\[([^|\]\[]+)\]#
 210     $self->link($1, $1)#ieg
 211     and return 1;
 212   $$rpart =~ s#font\[([^|\]\[]+)\|([^\]\[]+)\]#
 213     $self->_fix_spanned(qq/<font size="$1">/, "</font>", $2)#egi
 214     and return 1;
 215   $$rpart =~ s#anchor\[([^|\]\[]*)\]#<a name="$1"></a>#ig
 216     and return 1;
 217   $$rpart =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#
 218     $self->_fix_spanned(qq/<font size="$1" color="$2">/, "</font>", $3)#egi
 219     and return 1;
 220   $$rpart =~ s!(?<=\W)\[([^\]\[]+)\]!&#91;$1&#93;!g
 221     and return 1;
 222
 223   return 0;
 224 }
 225
 226 sub _tag_with_attrs {
 227   my ($self, $tag, $extra) = @_;
 228
 229   my $out = "<$tag";
 230   my @classes;
 231   while ($extra) {
 232     if ($extra =~ s/^\#([\w-]+)(?:\s+|$)//) {
 233       $out .= qq! id="$1"!;
 234     }
 235     elsif ($extra =~ s/^([a-z][\w-]*)(?:\s+|$)//i) {
 236       push @classes, $1;
 237     }
 238     elsif ($extra =~ s/^((?:[a-z][\w-]*: .*?;\s*)+)//) {
 239       $out .= qq! style="$1"!;
 240     }
 241     else {
 242       print STDERR "** don't understand $extra from $tag **\n";
 243       last;
 244     }
 245   }
 246   if (@classes) {
 247     $out .= qq! class="@classes"!;
 248   }
 249   $out .= '>';
 250
 251   return $out;
 252 }
 253
 254 sub _blocktag {
 255   my ($self, $tag, $attrs, $text) = @_;
 256
 257   return  $self->_fix_spanned
 258     ("\n\n" . $self->_tag_with_attrs($tag, $attrs), "</$tag>\n\n", $text)
 259 }
 260
 261 sub format {
 262   my ($self, $body) = @_;
 263
 264   print STDERR "format(...)\nbody: ",unpack("H*", $body),"\n" if DEBUG;
 265
 266   if ($body =~ /\n/) {
 267     $body =~ tr/\r//d;
 268   }
 269
 270   $body = $self->escape($body);
 271   my $out = '';
 272   for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
 273                         |embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*)){0,2}\]
 274                         |pre\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])/ix, $body) {
 275     #print STDERR "Part is $part\n";
 276     if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
 277       $out .= _make_html($1);
 278     }
 279     elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*),([^,\[\]]*)\]$/i) {
 280       $out .= $self->embed($1, $2, $3);
 281     }
 282     elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*)\]$/i) {
 283       $out .= $self->embed($1, $2);
 284     }
 285     elsif ($part =~ /^embed\[([^,\[\]]*)\]$/i) {
 286       $out .= $self->embed($1)
 287     }
 288     elsif ($part =~ /^pre\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
 289       my $work = $1;
 290       1 while $self->replace_char(\$work);
 291       $out .= "<pre>$work</pre>";
 292     }
 293     else {
 294       next unless $part =~ /\S/;
 295     TRY: while (1) {
 296         $self->replace(\$part)
 297           and next TRY;
 298         $self->replace_char(\$part)
 299           and next TRY;
 300         $part =~ s#pre\[([^\]\[]+)\]#<pre>$1</pre>#ig
 301           and next TRY;
 302         $part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#
 303             $self->_blocktag("h$1", $2, $3)#ieg
 304           and next TRY;
 305         $part =~ s#\n*h([1-6])\[\|([^\[\]]+)\]\n*#
 306           $self->_blocktag("h$1", '', $2)#ieg
 307           and next TRY;
 308         $part =~ s#\n*h([1-6])\[([^\[\]]+)\]\n*#
 309           $self->_blocktag("h$1", '', $2)#ieg
 310           and next TRY;
 311         $part =~ s#align\[([^|\]\[]+)\|([^\]\[]+)\]#\n\n<div align="$1">$2</div>\n\n#ig
 312           and next TRY;
 313         $part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]#_make_hr($1, $2)#ieg
 314           and next TRY;
 315         $part =~ s#hr\[([^|\]\[]*)\]#_make_hr($1, '')#ieg
 316           and next TRY;
 317         $part =~ s#table\[([^\n\[\]]*)\n([^\[\]]+)\n\s*\]#_make_table($1, $2)#ieg
 318           and next TRY;
 319         $part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_make_table($1, "|$2")#ieg
 320           and next TRY;
 321         #print STDERR "step: ",unpack("H*", $part),"\n$part\n";
 322         $part =~ s((?:^|\n+|\G)
 323                    ( # capture
 324                      (?: # an item
 325                        \ *   # maybe some spaces
 326                        (?:\*\*|\#\#|\%\%) # marker
 327                        [^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*  # some non-newline text
 328                        (?:\n|$)\n? # with one or two line endings
 329                        [^\S\n]* # and any extra non-newline whitespace
 330                      )
 331                      + # one or more times
 332                    )(\n|$)?)("\n\n"._format_lists($1)."\n\n")egx
 333           and next TRY;
 334         $part =~ s#indent\[([^\]\[]+)\]#<ul>$1</ul>#ig
 335           and next TRY;
 336         $part =~ s#center\[([^\]\[]+)\]#<center>$1</center>#ig
 337           and next TRY;
 338         $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#<table width="$1" height="$2" border="0" bgcolor="$3" cellpadding="0" cellspacing="0"><tr><td><img src="/images/trans_pixel.gif" width="1" height="1" alt="" /></td></tr></table>#ig
 339           and next TRY;
 340         $part =~ s#image\[([^\]\[]+)\]# $self->image($1) #ige
 341             and next TRY;
 342         $part =~ s#class\[([^\]\[\|]+)\|([^\]\[]+)\]#
 343           $self->_fix_spanned(qq/<span class="$1">/, "</span>", $2)#eig
 344           and next TRY;
 345         $part =~ s#style\[([^\]\[\|]+)\|([^\]\[]+)\]#
 346           $self->_fix_spanned(qq/<span style="$1">/, "</span>", $2)#eig
 347           and next TRY;
 348         $part =~ s#(div|address|blockquote)\[\n*([^\[\]\|]+)\|\n*([^\[\]]+?)\n*\]#"\n\n" . $self->_tag_with_attrs($1, $2) . "$3</$1>\n\n"#eig
 349           and next TRY;
 350         $part =~ s#comment\[[^\[\]]*\]##ig
 351           and next TRY;
 352         $part =~ s#(div|address|blockquote)\[\n*\|([^\[\]]+?)\n*]#\n\n<$1>$2</$1>\n\n#ig
 353           and next TRY;
 354         $part =~ s#(div|address|blockquote)\[\n*([^\[\]]+?)\n*]#\n\n<$1>$2</$1>\n\n#ig
 355           and next TRY;
 356         last;
 357       }
 358       $part =~ s/^\s+|\s+\z//g; # avoid spurious leading/trailing <p>
 359       $part =~ s!(\n([ \r]*\n)*)!$1 eq "\n" ? "<br />\n" : "</p>\n<p>"!eg;
 360       $part = "<p>$part</p>";
 361       1 while $part =~ s/<p>(<div(?: [^>]*)?>)/$1<p>/g;
 362       1 while $part =~ s!</div></p>!</p></div>!g;
 363       1 while $part =~ s/<p>(<blockquote(?: [^>]*)?>)/$1<p>/g;
 364       1 while $part =~ s!</blockquote></p>!</p></blockquote>!g;
 365       1 while $part =~ s/<p>(<address(?: [^>]*)?>)/$1<p>/g;
 366       1 while $part =~ s!</address></p>!</p></address>!g;
 367       $part =~ s!<p>(<hr[^>]*>)</p>!$1!g;
 368       $part =~ s!<p>(<(?:table|ol|ul|center|h[1-6])[^>]*>)!$1!g;
 369       $part =~ s!(</(?:table|ol|ul|center|h[1-6])>)</p>!$1!g;
 370       # attempts to convert class[name|paragraph] into <p class="name">...
 371       # tried to use a negative lookahead but it wouldn't work
 372       $part =~ s#(<p><span class="([^"<>]+)">(.*?)</span></p>)#
 373         my ($one, $two, $three)= ($1, $2, $3);
 374         $3 =~ /<span/ ? $one : qq!<p class="$two">$three</p>!#ge;
 375       $part =~ s#(<p><span style="([^"<>]+)">(.*?)</span></p>)#
 376         my ($one, $two, $three)= ($1, $2, $3);
 377         $3 =~ /<span/ ? $one : qq!<p style="$two">$three</p>!#ge;
 378       if (my $p_class = $self->tag_class('p')) {
 379         $part =~ s!(<p(?: style="[^"<>]+")?)>!$1 class="$p_class">!g;
 380       }
 381       #$part =~ s!\n!<br />!g;
 382       $out .= $part;
 383     }
 384   }
 385
 386   return $out;
 387 }
 388
 389 sub remove_format {
 390   my ($self, $body) = @_;
 391
 392   defined $body
 393     or confess "undef body supplied to remove_format";
 394
 395   if ($body =~ /^<html>/i) {
 396     return _strip_html(substr($body, 6));
 397   }
 398
 399   my $out = '';
 400   for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
 401                         |embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*)){0,2}\]
 402                         |pre\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])/ix, $body) {
 403     #print STDERR "Part is $part\n";
 404     if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
 405       $out .= _strip_html($1);
 406     }
 407     elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*)\]$/i) {
 408       $out .= ""; # what would you do here?
 409     }
 410     elsif ($part =~ /^embed\[([^,\[\]]*)\]$/i) {
 411       $out .= "";
 412     }
 413     elsif ($part =~ /^pre\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
 414       my $work = $1;
 415       $out .= $self->remove_format($work);
 416     }
 417     else {
 418     TRY: while (1) {
 419         $self->remove(\$part)
 420           and next TRY;
 421         $part =~ s#(?:acronym|abbr|dfn)\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]*)\]#$3#ig
 422           and next TRY;
 423         $part =~ s#(?:acronym|abbr|dfn|bdo)\[([^|\]\[]+)\|([^\]\[]*)\]#$2#ig
 424           and next TRY;
 425         $part =~ s#(?:acronym|abbr|dfn|bdo)\[\|([^|\]\[]*)\]#$1#ig
 426           and next TRY;
 427         $part =~ s#(?:acronym|abbr|dfn)\[([^|\]\[]*)\]#$1#ig
 428           and next TRY;
 429         $part =~ s#(?:strong|em|samp|code|var|sub|sup|kbd|q|address|blockquote|b|i|tt|span)\[([^|\]\[]+)\|([^\]\[]*)\]#$2#ig
 430           and next TRY;
 431         $part =~ s#(?:strong|em|samp|code|var|sub|sup|kbd|q|address|blockquote|b|i|tt|span)\[\|([^\]\[]*)\]#$1#ig
 432           and next TRY;
 433         $part =~ s#(?:strong|em|samp|code|var|sub|sup|kbd|q|address|blockquote|b|i|tt|span)\[([^\]\[]*)\]#$1#ig
 434           and next TRY;
 435         $part =~ s#div\[([^\[\]\|]+)\|([^\[\]]*)\](?:\r?\n)?#$2#ig
 436           and next TRY;
 437         $part =~ s#comment\[([^\[\]]*)\](?:\r?\n)?##ig
 438           and next TRY;
 439         $part =~ s#h([1-6])\[([^\[\]\|]*)\|([^\[\]]*)\](?:\r?\n)?#$3#ig
 440           and next TRY;
 441         $part =~ s#h([1-6])\[\|([^\[\]]*)\](?:\r?\n)?#$2#ig
 442           and next TRY;
 443         $part =~ s#h([1-6])\[([^\[\]]*)\](?:\r?\n)?#$2#ig
 444           and next TRY;
 445         $part =~ s#poplink\[([^|\]\[]*)\|([^\]\[]*)\]#$2#ig
 446           and next TRY;
 447         $part =~ s#poplink\[([^|\]\[]*)\]#$1#ig
 448           and next TRY;
 449         $part =~ s#link\[([^|\]\[]*)\|([^\]\[]*)\]#$2#ig
 450           and next TRY;
 451         $part =~ s#link\[([^|\]\[]*)\]#$1#ig
 452           and next TRY;
 453         $part =~ s#align\[([^|\]\[]+)\|([^\]\[]*)\]#$2#ig
 454           and next TRY;
 455         $part =~ s#font\[([^|\]\[]+)\|([^\]\[]*)\]#$2#ig
 456           and next TRY;
 457         $part =~ s#hr\[([^|\]\[]*)\|([^\]\[]*)\]##ig
 458           and next TRY;
 459         $part =~ s#hr\[([^|\]\[]*)\]##ig
 460           and next TRY;
 461         $part =~ s#anchor\[([^|\]\[]*)\]##ig
 462           and next TRY;
 463         $part =~ s#table\[([^\n\[\]]*)\n([^\[\]]+)\n\s*\]#_cleanup_table($1, $2)#ieg
 464           and next TRY;
 465         $part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_cleanup_table($1, "|$2")#ieg
 466           and next TRY;
 467         $part =~ s#\*\*([^\n]+)#$1#g
 468           and next TRY;
 469         $part =~ s!##([^\n]+)!$1!g
 470           and next TRY;
 471         $part =~ s!%%([^\n]+)!$1!g
 472           and next TRY;
 473         $part =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#$3#ig
 474           and next TRY;
 475         $part =~ s#(?:indent|center)\[([^\]\[]*)\]#$1#ig
 476           and next TRY;
 477         $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]##ig
 478           and next TRY;
 479         $part =~ s#image\[([^\]\[]+)\] *##ig
 480           and next TRY;
 481         $part =~ s#class\[([^\]\[\|]+)\|([^\]\[]*)\]#$2#ig
 482           and next TRY;
 483         $part =~ s#style\[([^\]\[\|]+)\|([^\]\[]*)\]#$2#ig
 484           and next TRY;
 485         $part =~ s!(?<=\W)\[([^\]\[]+)\]!\x01$1\x02!g
 486           and next TRY;
 487
 488         last TRY;
 489       }
 490       $part =~ tr/\x01\x02/[]/; # put back the bare []
 491       $out .= $part;
 492     }
 493   }
 494
 495   return $out;
 496 }
 497
 498 sub remove {
 499   0;
 500 }
 501
 502 # removes any html tags from the supplied text
 503 sub _strip_html {
 504   my ($text) = @_;
 505
 506   my $out = '';
 507   require HTML::Parser;
 508
 509   # this may need to detect and skip <script></script> and stylesheets
 510   my $ignore_text = 0; # non-zero in a <script></script> or <style></style>
 511   my $start_h =
 512     sub {
 513       ++$ignore_text if $_[0] eq 'script' or $_[0] eq 'style';
 514         if ($_[0] eq 'img' && $_[1]{alt} && !$ignore_text) {
 515           $out .= $_[1]{alt};
 516         }
 517     };
 518   my $end_h =
 519     sub {
 520       --$ignore_text if $_[0] eq 'script' or $_[0] eq 'style';
 521     };
 522     my $text_h =
 523       sub {
 524         $out .= $_[0] unless $ignore_text
 525       };
 526   my $p = HTML::Parser->new( text_h  => [ $text_h,  "dtext" ],
 527                              start_h => [ $start_h, "tagname, attr" ],
 528                              end_h   => [ $end_h,   "tagname" ]);
 529   $p->parse($text);
 530   $p->eof();
 531
 532   $text = $out;
 533
 534   return $text;
 535 }
 536
 537 # this takes the same inputs as _make_table(), but eliminates any
 538 # markup instead
 539 sub _cleanup_table {
 540   my ($opts, $data) = @_;
 541   my @lines = split /\n/, $data;
 542   for (@lines) {
 543     s/^[^|]*\|//;
 544     tr/|/ /s;
 545   }
 546   return join(' ', @lines);
 547 }
 548
 549 my %ms_entities =
 550   (
 551    34 => 'quot',
 552    60 => 'lt',
 553    62 => 'gt',
 554    38 => 'amp',
 555    128 => '#x20ac',
 556    130 => '#x201a',
 557    131 => '#x192',
 558    132 => '#x201e',
 559    133 => '#x2026',
 560    134 => '#x2020',
 561    135 => '#x2021',
 562    136 => '#x2c6',
 563    137 => '#x2030',
 564    138 => '#x160',
 565    139 => '#x2039',
 566    140 => '#x152',
 567    142 => '#x17D',
 568    145 => 'lsquo',
 569    146 => 'rsquo',
 570    147 => 'ldquo',
 571    148 => 'rdquo',
 572    149 => '#x2022',
 573    150 => 'ndash',
 574    151 => 'mdash',
 575    152 => '#x2dc',
 576    153 => 'trade',
 577    154 => '#x161',
 578    155 => '#x203a',
 579    156 => '#x153',
 580    158 => '#x17e',
 581    159 => '#x178',
 582   );
 583
 584 sub escape {
 585   my ($self, $html) = @_;
 586
 587   if ($self->{conservative_escape}) {
 588     return escape_html($html, '<>&"');
 589   }
 590   elsif ($self->{msentify}) {
 591     $html =~ s{([<>&\"\x80-\x9F])}
 592       { $ms_entities{ord $1} ? "&$ms_entities{ord $1};"
 593              : "** unknown code ".ord($1). " **"; }ge;
 594
 595     return $html;
 596   }
 597   else {
 598     return escape_html($html);
 599   }
 600 }
 601
 602 # for subclasses to override
 603 sub tag_class {
 604   return;
 605 }
 606
 607 1;