EVOLUTION-MANAGER

Edit File: deHTML.pm

package Razor2::Preproc::deHTML;

sub new {

my $class = shift;

my %html_tags = (
        "lt"    => '<',        "gt" => '>',           "amp" => '&',
        "quot"  => '"',        "nbsp" => ' ',         "iexcl" => chr(161),
        "cent"  => chr(162),   "pound" => chr(163),   "curren" => chr(164),
        "yen"   => chr(165),   "brvbar" => chr(166),  "sect" => chr(167),
        "uml"   => chr(168),   "copy" => chr(169),    "ordf" => chr(170),
        "laquo" => chr(171),   "not" => chr(172),     "shy" => chr(173),
        "reg"   => chr(174),   "macr" => chr(175),    "deg" => chr(176),
        "plusmn" => chr(177),  "sup2" => chr(178),    "sup3" => chr(179),
        "acute" => chr(180),   "micro" => chr(181),   "para" => chr(182),
        "middot" => chr(183),  "cedil" => chr(184),   "sup1" => chr(185),
        "ordm" => chr(186),    "raquo" => chr(187),   "frac14" => chr(188),
        "frac12" => chr(189),  "frac34" => chr(190),  "iquest" => chr(191),
        "Agrave" => chr(192),  "Aacute" => chr(193),  "Acirc" => chr(194),
        "Atilde" => chr(195),  "Auml" => chr(196),    "Aring" => chr(197),
        "AElig" => chr(198),   "Ccedil" => chr(199),  "Egrave" => chr(200),
        "Eacute" => chr(201),  "Ecirc" => chr(202),   "Euml" => chr(203),
        "Igrave" => chr(204),  "Iacute" => chr(205),  "Icirc" => chr(206),
        "Iuml" => chr(207),    "ETH" => chr(208),     "Ntilde" => chr(209),
        "Ograve" => chr(210),  "Oacute" => chr(211),  "Ocirc" => chr(212),
        "Otilde" => chr(213),  "Ouml" => chr(214),    "times" => chr(215),
        "Oslash" => chr(216),  "Ugrave" => chr(217),  "Uacute" => chr(218),
        "Ucirc" => chr(219),   "Uuml" => chr(220),    "Yacute" => chr(221),
        "THORN" => chr(222),   "szlig" => chr(223),   "agrave" => chr(224),
        "aacute" => chr(225),  "acirc" => chr(226),   "atilde" => chr(227),
        "auml" => chr(228),    "aring" => chr(229),   "aelig" => chr(230),
        "ccedil" => chr(231),  "egrave" => chr(232),  "eacute" => chr(233),
        "ecirc" => chr(234),   "euml" => chr(235),    "igrave" => chr(236),
        "iacute" => chr(237),  "icirc" => chr(238),   "iuml" => chr(239),
        "eth" => chr(240),     "ntilde" => chr(241),  "ograve" => chr(242),
        "oacute" => chr(243),  "ocirc" => chr(244),   "otilde" => chr(245),
        "ouml" => chr(246),    "divide" => chr(247),  "oslash" => chr(248),
        "ugrave" => chr(249),  "uacute" => chr(250),  "ucirc" => chr(251),
        "uuml" => chr(252),    "yacute" => chr(253),  "thorn" => chr(254),
        "yuml" => chr(255)
    );

return bless {
        html_tags => \%html_tags,
    }, $class;

}

sub isit {

my ($self, $text) = @_;
    my $isit = 0;
    my ($hdr, $body) = split /\n\r*\n/, $$text, 2;

return 0 unless $body;

$isit = $body =~ /(?:<HTML>|<BODY|<FONT|<A HREF)/ism;
    return $isit if $isit;

$isit = $hdr =~ m"^Content-Type: text/html"ism;
    return $isit;

}

# NOTE: Tag designations _are_ case sensitive.
# Returns: (length of tag detected, char)
# So the caller can basically do ``$i += $length_detected'', above.
#
# The big difference between this function and its C equivalent is
# that we're not modifying the char array that was passed in, but
# rather instead advising the caller on how much to skip/eat.

sub html_xlat_old {

my($self, $chars, $i) = @_;
    my($tag, $val);
    my($r_val);
    my $r_tag = "";

return 0 if ($$chars[$i] !~ /[a-zA-Z]/);

# first figure out which is shorter, $i->EOS, or $i+10, and use
    # that to build a compare string for use with substr.  Otherwise,
    # requesting ``lengths'' from char arrays that exceeds the actual
    # array produce additional 'undef's.  10 is an arbitrary #, but at
    # least greater than the max length (+ 1) of any html &tag.

my($offset) = (scalar @{$chars} - $i > 10 ? 10 : scalar @{$chars} );
    my($s) = join ('', @{$chars}[$i .. $i + $offset]);

while ( ($tag, $val) = each %{$self->{html_tags}} ) {

if (substr($s, 0, length($tag)) eq $tag) {
            ($r_tag, $r_val) = ($tag => $val);
            $r_tag .= ';' # so the length($r_tag) consumes the ``;''
               if (substr($s, length($tag), 1) eq ';');
        }
    }

return (length($r_tag), $r_val);

}

sub html_xlat {
    my($self, $chars, $i) = @_;

#print "html_xlat($r_tag) start\n";
    return 0 if ($$chars[$i] !~ /[a-zA-Z]/);

my $r_tag;
    # we used to walk till we got a ';', but to be compatible
    # with c, we won't check for ';'
    while ($$chars[$i] && $$chars[$i] =~ /[a-zA-Z]/) {
        $r_tag .= $$chars[$i++];
    }
    my $len = length($r_tag);  # do not include ;
    $len++ if ($$chars[$i] eq ';');

my $val = $self->{html_tags}->{$r_tag};
    #print "html_xlat($r_tag) = ($len,$val)\n";

return 0 unless $val;  # not found 
    return ( $len, $val );
}

sub doit {

my ($self, $text) = @_;
    my ($hdr, $body) = split /\n\r*\n/, $$text, 2;

my(@chars) = split //, $body;
    my($len) = scalar @chars;

my($last, $quote, $sgml, $tag) = ("", "", "", "");
    my(@out);
    my($i) = 0;

while ($i < $len) {
	my($c) = $chars[$i++];

if ($c eq $quote) {

if ($c eq '-' && $last ne '-') {
		$last = $c;
		next;
	    } else {
		$last = 0;
	    }

$quote = "";

} elsif (!$quote) {

if ($c eq '<') {

$tag = 1;
		if ($chars[$i++] eq '!') {
                    my($s) = join('', @chars[$i .. $i + 10]);
		    $sgml = 1;
		}
		
	    } elsif ($c eq '>') {
    
		if ($tag) {

$sgml = 0;
		    $tag = 0;
		}

} elsif ($c eq '-') {

if ($sgml and $last eq '-') {

$quote = '-';
		} else {
		push @out, $c if (! $tag);
		}

} elsif ($c eq "\"" or $c eq "\'") {
		
		if ($tag) { 
                  $quote = $c ;
		} else {
		push @out, $c if (! $tag);
                }

} elsif ($c eq "&") {

my($len, $char) = $self->html_xlat(\@chars, $i);
		if ($len) {
		    push @out, $char;
		    $i += $len;
		} else {
		    push @out, $c;
		}
		
	    } else {

push @out, $c if (! $tag);

}

$last = $c;
    }

$$text = "$hdr\n\n". join('', @out);

}